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A DEVICE  INDEPENDENT  GRAPHICS  KERNEL 


Walter  W.  Jones 
Alicia  B.  Fadell 

Abstract 

This  paper  describes  an  interface  for  programs  which  allows  one  to  write 
graphics  primitives  to  several  devices  without  regard  for  the  type  of 
device.  The  most  salient  features  are  that  it  has  low  overhead,  is 
transportable  and  can  be  expanded  as  the  nature  of  the  Input/output  devices 
changes.  A conscious  effort  has  been  made  to  include  all  normal  graphics 
primitives  together  with  the  most  useful  high  level  routines  without 
compromising  the  use  of  special  features  of  custom  display  units. 

Ke3u^7ords:  device  Independence,  display  devices,  graphics 


1 . INTRODUCTION 

This  paper  describes  a graphics  package  which  is  intended  to  ease  the  use 
of  input/output  devices  in  acquiring  and  displaying  information  graphically. 
The  intent  is  to  reduce  the  problem  to  its  simplest  level  by  allowing  one  to 
describe  graphs  in  much  the  same  way  one  thinks  of  them.  A further  intent  is 
to  make  the  user  language  truly  device  independent  and  allow  a programmer  or 
other  user  to  switch  devices  interactively  simply  by  identifying  the  desired 
input  and  output  devices.  As  much  as  possible,  the  similarity  in  instructions 
to  different  devices  is  maintained.  There  are  some  limitations  of  course. 

Pen  plotters  do  not  normally  come  with  erasers  and  most  storage  scopes  (e.g. , 
Tektronics)  are  not  erasable  on  the  individual  pixel  level.  Beyond  this  no 
function  which  is  available  for  a particular  device,  but  not  supported  because 
there  is  no  commonality  amongst  the  devices,  is  rendered  unavailable.  Thus, 
even  for  specialized  usage,  this  package  will  take  care  of  normal 
Initialization  and  setup. 

The  devices  which  are  currently  supported  are  Plot-10  emulators,  CALCOMP 
pen  plotters,  a line  printer  and  the  Lexidata  3400/8100  series^.  These 
devices  encompass  most  protocols  and  slots  have  been  left  in  the  package  for 
future  expansion.  We  currently  support  these  devices  since  those  are  the  ones 
which  are  available.  Any  suggestions  for  expansion  or  additional  functions 
are  welcome. 


2.  OVERVIEW 

Graphics  application  programs  may  be  required  to  send  output  to  or  accept 
input  from  several  devices.  Since  each  output  device  is  supported  by  differ- 
ent sets  of  graphics  routines,  writing  application  programs  is  normally 


Certain  commerlcal  equipment  is  identified  in  this  paper  in  order  to 
illustrate  adequately  certain  device  specific  characteristics.  Such 
idenlf ication  does  not  imply  recommendation  or  indorsement  by  the  National 
Bureau  of  Standards,  nor  does  it  imply  that  the  equipment  is  necessarily  the 
best  availale  for  the  purpose. 
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burdensome  since  applications  may  reguire  several  device-dependent  versions  of 
each  program.  Alternatively,  each  application  could  include  all  the  device- 
dependent routines  in  one  version  of  each  program,  and  call  only  the  routines 
required  for  a specific  device,  e.g.,  by  means  of  GO  TO  statements.  In  either 
case,  when  a new  device  is  added  to  the  work  environment,  application  program- 
mers must  learn  another  set  of  graphics  routines  and  write  new  codes  for  each 
application.  This  reprogramming  can  be  time-consuming  and  costly. 

A graphics  system  which  supports  several  input  and  output  devices,  while 
hiding  the  device-dependent  routines  from  the  user,  is  desirable.  DEVICE  is  a 
package  of  FORTRAN  subroutines  for  producing  graphics  output  on  several 
devices.  The  package  consists  of  one  standard  routine  for  each  output  primi- 
tive (line,  polygon,  character,  etc.).  Once  a device  has  been  identified,  a 
primitive  is  displayed  through  a call  to  the  appropriate  routine.  This 
routine  is  also  used  to  generate  the  same  output  on  other  devices.  Hence 
DEVICE  is  an  interface  between  the  application  program  and  the  input/output 
devices  since  each  standard  routine  is  device-independent,  as  shown  in 
Figure  1. 


Every  hardware  interface  routine  is  divided  into  sections.  Each  of  these 
sections  is  devoted  to  a device.  Once  a primitive  is  called  by  a program, 
command  goes  to  the  section  designed  for  the  accessed  device,  as  shown  in 
table  1. 


application  program 


console 


interface 


FIGURE  1 
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Table  1 

A Sample  of  the  Hardware  Interface  Protocol 


SUBROUTINE  SAMPLE 


COMMON/DEV /IDEV 
GO  TO  (1 ,2, . . .n)  IDEV 

C CALCOMP  SECTION 

r graphics  subroutines 

RETURN 

C PRINTER  SECTION 

^ • graphics  subroutines 

RETURN 


END 

The  coordinates  used  in  labeling  a viewing  area  differ  for  each  device. 
Therefore,  the  user's  data  points  must  be  converted  into  device  coordinates 
(see  section  5).  This  conversion  is  done  by  DEVICE  before  device-dependent 
routines  are  called.  The  format  of  a typical  graphics  subroutine  is 

SUBROUTINE  SAMPLE 


COMMON /DEV /IDEV 
GO  TO  (1,2,. ..n)  IDEV 

C CALCOMP  SECTION 

1 convert  to  CALCOMP  coordinates 

call  CALCOMP  graphics  routines 
RETURN 

C PRINTER  SECTION 

2 convert  to  PRINTER  coordinates 

call  PRINTER  graphics  routines 
RETURN 


C CONSOLE  SECTION 

n convert  to  CONSOLE  coordinates 

call  CONSOLE  graphics  routines 
RETURN 
END 
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2.1  Structure  of  the  Package 


These  routines  can  be  grouped  into  6 categories  summarized  below  and 
defined  in  table  2.  More  detail  is  given  in  the  apprendixes. 

1 . Device  Control  - utility  routines  which  include 

initialization  and  termination  procedures 
for  the  device 

2.  Viewing  - specify  the  part  of  the  user’s  coordinate  system  to 

display  and  where  to  place  the  display  on  the  view- 
ing surface 

3.  Output  Primitives  - define  objects  and  display  them  on  the 

viewing  surface 

4.  Attributes  - define  the  appearance  of  the  output  primitives 

5.  Auxiliary  - miscellaneous  routines 

6.  Input  - acquire  data. 
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Table  2.  Graphics  Subroutines  - General  Format 


1 . Device  Control 
DEVICE  (n) 

NEWFRM 

HDCOPY 

FRAME 

ERASE 

ENDFRM 

2 . Viewing 

SCALNG  (XI,  Yl,  X2,  Y2, 

XIH,  YIH,  X2H, 

Y2H,  XIS,  YIS, 

X2S,  Y2S) 

DEFINE  (XI,  Yl,  X2,  Y2) 

3 . Output  Primitives 
LINE  (XI , Yl , X2,  Y2) 

LINES  (XI,  Yl,  X2,  Y2,  N) 

LNPLOT  (X,  Y,  II,  12,  13) 

PLYGON  (X,  Y,  N) 

BOXPLT  (XI,  Yl,  X2,  Y2) 

CIRCLE  (X,  Y,  R) 

SURFAC  (Z,  NX,  NY,  MODE) 

CONTUR  (F,  TEST,  NX,  NY,  FL) 

VOLUME  (MODE,  F,  NX,  NY,  NZ , 
CLEVEL,  NCL,  T,  NT) 

SYMBOL  (X,  Y,  CHAR) 

CHPLOT  (X,  Y,  CHAR,  II,  12,  13 

HHDRAW  (X,  Y,  SX,  SXY,  ICHAR, 
NSET,  NSET,  lERR) 

WDDRAW  (X,  Y,  DX,  DY,  SX,  SXY 
SY,  CHARS) 


Function 

initialize  a graphics  device 

clear  the  screen  and  initialize  a 
new  frame 

generate  a hard  copy 

write  out  the  buffer 

clear  the  screen  (also  done  in 
"NEWFRM" ) 

close  the  graphics  device 
Function 

define  the  window  and  viewport 

define  the  window  (viewport  defaults 
to  entire  viewing  surface) 

Function 

draw  a line  between  2 points 

draw  a line  between  points  in  an 
array  of  length  n 

draw  lines  between  selected  points 
of  an  array 

draw  a closed  polygon 

draw  a rectangle 

draw  a circle 

performs  surface  plotting 

performs  contour  plotting 

performs  volume  plotting 
(3  dimensional  contouring) 

draws  a specified  hardware  character 
at  a given  point 

draws  a specified  hardware  character 
at  selected  points  in  an  array 

draws  a particular  character  of 
the  specified  character  set 

draws  a character  string 
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LABEL  (CHARS,  XI,  Y1 , X2 , Y2, 
ANGLE) 

ALABEL  (CHARS,  XI,  X2 , Yl,  Y2 , 
ANGLE) 

FNUMBR  (X,  Y,  DX,  DY,  SX,  SXY, 

SY,  XNUMBR,  WIDTH,  DIGITS) 

ENUMBR  (XNUMBR,  XI,  Yl,  X2 , Y2) 

GRAFIT  (NPLT,  XI,  X2 , XIR,  X2R, 
XXI,  XX2,  Yl,  Y2,  YIR, 

Y2R,  YYl,  YY2,  XTIT,  NDVX, 
YTIT,  NDVY) 

PLYPLT  (F,  IS) 

MAPIN  (FW,  V,  NV,  E,  ES, 

NE,  P,  PS,  NP) 

MAPOUT  (W,  V,  NV,  E,  ES,  NE, 

P,  PS,  NP) 

VIEWTR  (X,  W,  V,  NV,  E,  ES, 

NE,  P,  PS,  NP) 

4.  Attributes 
COLOR  (N) 

LINWID  (N) 

FILTYP  (N) 

CHRSIZ  (CHFRZ,  GCHFRZ) 

CHRSET  (N) 

5 . Auxiliary 
lOWAIT  (N) 

SETDEV  (Nl,  N2) 

DELAY  (N) 

SETLUT 

6.  Input 

DEVINP  (I,  status,  X,Y,Z) 


draws  a character  string 

draws  a character  string  with 
aspect  ratio  4/3 

draws  a real  number  in  FORTRAN 
F-type  format 

draws  a real  number  in  exponential 
(E)  format  (E  - type) 

sets  up  a graph  (x  and  y axis) 
for  plotting  data 


read  in  a "BUILD"  formatted 
structure  file,  F and  display 
according  to  IS 

read  a "BUILD"  file  and  return 
the  vertices,  edges  and  polygons. 
Files  are  appended  after  the  initial 
call. 

display  the  specified  edges  as 
given 

display  the  specified  edges  and 
polygons  using  the  transform  matrix 

X. 

Function 

defines  the  color  for  drawing 

defines  the  line  width 

defines  the  appearance  of  the 
interior  of  polygons  and  circles 

sets  the  size  of  the  hardware 
characters 

changes  the  default  character  set 
Function 

puts  a pause  in  the  program 
changes  logical  units 
delays  for  hard  copy  units 
sets  up  the  color  look-up  table 


read  input  coordinates  triplet  from 
a device 
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3.  COORDINATE  SYSTEMS 


The  application  must  define  the  environment  in  which  it  will  operate. 

For  instance,  temperature  may  be  calculated  in  degrees  Celsius  for  one  study, 
while  length  is  measured  in  feet  for  another  project.  Data  can  be  sent  to  the 
DEVICE  routines  directly  from  the  application;  no  conversion  to  a standard 
unit  is  required  of  the  user.  Within  the  graphics  package,  however,  the  data 
coordinates  must  be  converted  to  device-dependent  coordinates  for  the 
individual  hardware. 

The  user  space  is  a 3-dimensional  left-handed  coordinate  system  (positive 
x-axis  to  the  right,  positive  y-axis  up,  and  positive  z-axis  into  the  viewing 
surface).  Data  points  are  added  to  the  space  in  "application-dependent" 
coordinates.  Before  these  points  can  be  displayed,  a window  and  a viewport 
must  be  specified. 

The  window,  a rectangle  in  the  x-y  plane  of  the  user  space,  encloses  the 
points  to  be  displayed.  This  window  is  mapped  into  the  device's  world  space. 
The  world  space  is  labeled  differently  for  each  device.  The  world  space  is 
determined  by  the  device's  fixed  points  (XIS,  YIS)  and  (X2S,  Y2S).  The  window 
is  defined  by  the  user  who  specifies  the  diagonal  endpoints  (XI,  Yl)  and  (X2, 
Y2).  The  window  is  mapped  to  the  world  space  by  the  scale  factors: 

XYCOORD(l)  = (X2S  - X1S)/(X2  -XI) 

XYC00RD(2)  = XIS  - XI  * XYCOORD(l) 

XYC00RD(3)  = (Y2S  - Y1S)/(Y2  - Yl) 

XYC00RD(4)  = YIS  - Yl  * XYC00RD(3) 

A point  (X,Y)  in  the  user  space  is  converted  to  the  world  coordinate 
(XS,YS)  by  the  transformation: 

XS  = X * XYGOORD(l)  + XYC00RD(2) 

YS  = Y * XYC00RD(3)  + XYC00RD(4) 

Any  point  within  the  user's  window  will  be  converted  into  valid  world 
coordinates  (i.e.,  XIS  ^ XS  ^ X2S  and  YIS  ^ YS  _<  Y25)  and  can  be  plotted. 

Other  points  will  be  mapped  out  of  the  device's  range  and  should  not 

displayed  on  the  viewing  surface. 


(X2S,Y2S) 
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The  part  of  the  viewing  surface  which  will  contain  the  display  is  called 
the  viewport.  The  viewport  defaults  to  the  entire  viewing  surface.  In  order 
to  place  the  display  on  a smaller  portion  of  the  viewing  surface,  the  desired 
rectangular  area  must  be  specified.  The  device  coordinates  (XIH,  YIH)  and 
(X2H,  Y2H)  are  used  to  define  this  viewport.  The  world  space  is  then  mapped 
onto  the  viewport.  Hence,  all  data  points  in  the  user  space  are  converted  to 
device  coordinates  through  2 transformations.  Only  points  in  the  user's 
window  will  be  transformed  into  valid  device  coordinates  (i.e.,  coordinates 
within  the  device's  viewport). 


FIGURE  3 


Usual  usage  is  to  transform  the  viewport  to  the  entire  viewable  space 
(view  surface).  In  this  case  a call  to  DEFINE  is  sufficient.  The  default 
values  for  the  device  world  coordinate  space  are  used,  and  the  defined  window 
is  mapped  to  the  maximum  normalized  device  coordinates.  Special  applications 
might  require  other  tranf ormations . Such  a facility  is  provided  by  SCALNG. 
This  routine  specifies  the  transform  from  user  space  to  world  coordinate 
space,  from  world  coordinate  space  to  normalized  device  coordinates  and 
finally  to  the  device  (or  hardware)  address  units.  Table  3 shows  the  default 
values  for  the  current  list  of  output  device. 
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TABLE  3 

DEVICE  COORDINATES 


OUTPUT 


WORLD 


NORMALIZED 


PHYSICAL 


X 

Y 

X 

Y 

X 

Y 

Lexidata 

128000 

102300 

32700 

26160 

1279 

1023 

Tek  40XX 

1280 

1024 

1029 

1029 

1023 

768 

CALCOMP 

- 

- 

1029 

1023 

10.75 

8.75 

Printer 

1279 

1023 

1279 

1023 

128 

50 

The  physical  (device)  coordinates  map  windows  to  the  full  viewing 
space.  Some  applications  require  use  of  only  a portion  of  this  space.  An 
example  is  the  reduction  of  about  15%  of  the  linear  dimensions  in  order  to  fit 
into  a 512  line  raster  scan  television  frame. 


4.  STRUCTURE  DATA  FILES 

Several  programs  create  and  modify  structure  files  for  graphical 
display.  The  elements  used  to  compose  these  structures  are  vertices,  edges, 
and  polygons.  The  elements  are  stored  in  user  coordinates  in  the  data  file. 
Attributes  for  these  elements  along  with  the  specifications  of  the  user  space, 
are  also  stored  in  this  file. 

Listed  at  the  beginning  of  the  data  file  are  the  dimensions  of  the  user 
space  and  the  window  space.  The  boundaries  of  the  window  are  put  into  the 
WINDOW  array:  WINDOW  (1  ->  4)  {(left  - bottom),  and  (right  - top), 

respectively},  while  the  boundaries  of  the  user  space  are  sent  to  the  WORLD 
array:  WORLD  (1  ->•  6)  (left,  bottom,  front,  and  right,  top,  back), 

respectively.  This  latter  three  dimensional  space  specification  is  not 
currently  used. 

The  following  two  images  in  the  data  files  specify  the  number  of 
vertices,  elements  (defined  as  polygons  + edges)  and  the  number  of  edges,  and 
a description  of  the  elements  by  groups.  This  latter  is  currently  implemented 
only  in  ADDMAP,  described  in  Section  6.3. 

The  data  for  the  elements  and  attributes  comprise  the  remaining  part  of 
the  file.  The  vertex  coordinates  (x,y,z)  are  stored  next,  followed  by  element 
pointers.  The  input  routines  read  the  data  for  the  vertices  into  the  array 
VERTEX  (i,j).  Here,  the  row  index,  i,  (possible  values  = 1,2,3)  refers  to  the 
i^  coordinate  (x,  y,  or  z,  respectively)  and  the  column  vector  j refers  to 
the  vertex  number.  For  instance  VERTEX  (2,5)  stores  the  value  of  the  y 
coordinate  of  the  5*"  vertex.  In  the  file,  each  coordinate  triplet  is 
preceded  by  zero  (0)  or  one  (1).  A zero  indicates  that  the  vertex  was  deleted 
from  the  user  space  (i.e.,  the  vertex  is  not  used  for  displaying  or  for 
constructing  edges  and  polygons)  but  was  not  deleted  from  the  data  file.  A 
one  (1)  specifies  that  the  vertex  exists  in  the  user  space.  An  example  would 
be  deleting  a polygon  without  removing  the  corresponding  vertices. 
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The  vertices  are  grouped  together  to  form  edges  and  polygons.  Following 
the  list  of  vertex  coordinates  is  the  list  of  elements.  Each  element,  either 
an  edge  or  a polygon,  is  identified  by  its  endpoints  which  are  in 

EDGE  (i,j)  or  POLY(i,j), 

where  i specifies  which  of  the  two  endpoints  and  j Indicates  the  element 
number.  For  example,  if  the  fourth  edge  is  composed  of  vertices  6 and  10,  we 
have 


EDGE  (1,4)  = 6 and  EDGE  (2,4)  = 10 


Polygons  are  stored  in  a similar  manner.  P0LY(i,j)  contains  the  vertex  number 
of  the  i^  vertex  of  the  polygon.  Polygons  have  no  more  than  NPVERT 
(currently  8)  vertices. 

Data  for  each  edge  or  polygon  fills  one  row  of  the  data  file.  The 
element’s  vertices  are  listed  first  and  are  followed  by  the  element's  attri- 
butes. The  attributes  are  read  into  the  arrays  ESPEC  (i,j)  or  PSPEC  (i,j)  for 
edges  and  polygons,  respectively.  Here  the  1 specifies  the  attribute  and  j 
indicates  the  element  number. 


^ ESPEC  (i,j) 

1 line  width 

2 color 

3 line  attribute 

4 <unused> 


PSPEC  (i,j) 

1 line  width 

2 color 

3 fill  type 

4 polygon  (^0)  or  polyline  (<0) 


A sample  data  file  is  shown  in  Table  3.  In  this  file  there  are  9 valid 
vertices,  1 "deleted"  vertex,  1 edge,  and  3 polygons.  (Note  that  the  last 
polygon  is  actually  a polyline. T The  same  data  as  listed  by  the  BUILD  program 
is  shown  in  Table  4. 


Table  3 


BUILD  O.OOOOOE+00  O.OOOOOE+00  1.28000E+03  1.02400E+03 

-1.00000E+09-1.00000E+09-1.00000E+09  l.OOOOOE+09  l.OOOOOE+09  l.OOOOOE+09 


10  4 

4 

1.55608E+02 

4.03576E+02 

5.00956E+02 

2.60015E+02 

4.36470E+02 

9.64768E+02 

5.30060E+02 

5.30070E+02 

8.03136E+02 

8.03136E+02 

4 6 0 0 

12  3 0 

6 7 8 9 

14  7 0 


7.37531E+02  O.OOOOOE+00 
9.39818E+02  O.OOOOOE+00 
7.45070E+02  O.OOOOOE+00 
6.44554E+02  O.OOOOOE+00 
3.88245E+02  O.OOOOOE+00 
6.44554E+02  O.OOOOOE+00 
3.68136E+02  O.OOOOOE+00 
5.88014E+02  O.OOOOOE+00 
5.88014E+02  O.OOOOOE+00 
4.63627E+02  O.OOOOOE+00 
000002100 
000002100 
000002810 
000002  10  -1 
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The  edge,  polygon  and  polyline  entries  in  Table  3 are  integer  format.  In  this 
case  there  are  13  entries  for  each  element.  For  polygons  and  polylines, 

NPVERT  entries,  a zero  for  compatibility  with"MOVIE, BYU"  and  the  4 NSPEC 
entries.  For  edges,  here  are  two  entries,  seven  zeros  and  the  4 ESPEC 
entries . 


Table  4 


WORLD 

LEFT, BOTTOM, FRONT:  -l.OE+09 

RIGHT,  TOP,  BACK:  l.OE+09 


WINDOW 

-l.OE+09  -l.OE+09  LEFT  BOTTOM:  0.0  0.00 

l.OE+09  l.OE+09  RIGHT, TOP:  1.3E+03  l.OE+03 


VERTEX(X,Y,Z) 


1) 

155.61 

737.53 

0.00000 

2) 

403.58 

939.82 

0.00000 

3) 

500.96 

745.07 

0.00000 

4) 

260.02 

644.55 

0.00000 

6) 

964.77 

644.55 

0.00000 

7) 

530.07 

368.14 

0.00000 

8) 

530.07 

588.01 

0.00000 

9) 

803.14 

588.01 

0.00000 

10) 

803.14 

463.63 

0.00000 

EDGES 

SPECS 

1) 

4 6 

2 

1 0 

0 

POLYGONS 

SPECS 

1) 

1 2 3 

0 

0 0 

0 0 

2 

1 0 

0 

2) 

6 7 8 

9 

0 0 

0 0 

2 

8 1 

0 

3) 

1 4 7 

0 

0 0 

0 0 

2 

1 0 

-1 

5.  INPUT/OUTPUT  DEVICES 

Currently  four  separate  input  and  output  devices  are  supported.  These 
encompass  all  the  common  standard  Interfaces  and  the  flexibility  exists  to 
include  any  future  Input/output  device  for  which  a transformation  between  the 
hardware  and  mathematical  space  can  be  given.  The  devices  for  output  are  a 
CALCOMP  pen  plotter  (1012),  Tektronix  40XX  or  emulator,  Lexidata  Displays 
(8100  and  3700)  and  a line  printer.  Devices  for  input  are  a digitizing 
tablet,  a joystick,  segments  in  the  Lexidata  picture  descriptor  lists  which 
can  be  "picked"  and  ASCII  input  from  a keyboard  or  file. 


The  software  maintains  three  dimensional  picture  descriptors.  Although 
only  the  Lexidata  3700  can  utilize  this  capability  directly,  perspective  and 
visual  cuing  can  be  shown  on  the  other  devices.  The  coordinate  limits  of  the 
hardware  are  shown  in  Table  5 . 
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TABLE  5 


DEVICE 

Xmin/Xmax 

Ymin/Ymax 

Zmin/Zmax 

Tektronix  40XX 

0/768 

0/1023 

— 

Printer 

1/128 

format  limited 

- 

Joystick 

0/32767 

0/26160 

- 

Lexidata  8100 

0/1279 

0/1023 

- 

Lexidata  3700 

0/1279 

0/1023 

0/4095 

Tablet 

0/12190 

0/9142 

- 

Segments 

0/~  10^ 

0/~  10 

Calcomp  plotter 

0/11.5 

0/8.5 

These  are  the  local  address  modes  for  pixels  and  not  the  normalized 
device  coordinates  (see  section  3).  This  group  of  devices  includes  almost  all 
standard  protocols  for  graphics  interfaces.  These  are  the  CORE  standard, 
escape  sequences,  direct  (DMA)  input/output  of  pixels,  line  oriented 
input/output  (ASCII)  and  the  very  early  protocols  formulated  by  Tektronix  and 
CALCOMP.  Slots  have  been  left  in  the  software  to  accomodate  new  devices.  At 
the  time  of  this  writing,  the  GKS  standard  has  not  been  formalized.  However, 
if  it  is  similar  to  the  proposed  standard  then  inclusion  of  devices  which 
follow  this  protocol  is  straightforward. 


6.  IMPLEMENTATION 

6.1  BUILD 

The  BUILD  program  is  used  to  create,  modify,  or  display  files  consisting 
of  vertices,  edges,  and  polygons.  These  files  also  contain  the  elements' 
characteristics:  line  width,  color,  and  polygon  fill  type.  The  first  step  in 
creating  a file  is  to  specify  the  user  space  and  the  window.  The  user  space 
defaults  to  a cube  centered  at  the  origin  and  having  sides  of  length 
6 X 10^.  Prompts  are  used  by  the  programs  when  needed.  There  are  no  default 
values  for  the  window  space.  The  x and  y coordinates  of  the  window  must  be 
specified  with  a call  to 

WINDOW 

At  this  point,  data  for  the  various  structures  may  be  entered  and 
subsequently  modified  or  displayed.  The  work  file,  however,  need  not  be  a new 
file.  It  is  possible  to  alter  or  display  data  of  an  existing  file.  The 
command  to  access  an  old  file  is 

GET  [filename] 

where  the  file  defaults  to  INFILE,  the  last  file  accessed.  Similarly,  a work 
file  may  be  saved  by 
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SAVE  [filename] 

In  this  case,  the  default  file  is  OUTFILE  which  is  the  last  file  that  was 
saved.  A check  of  the  filenames  stored  in  INFILE  and  OUTFILE  is  possible  by 
calling 

STATUS 


This  command  also  Indicates  the  number  of  vertices,  edges,  and  polygons  in  the 
work  file  along  with  the  maximum  number  of  each  element  allowed. 


The  work  file  is  modified  in  several  ways. 


file  with 


( VERTEX 

ADD  { EDGE 

( POLYGON 


Elements  are  added  to  the 


(default  = VERTEX) 


Vertices  are  input  by  specifying  three  (x,y,z)  coordinates.  Edges  are 
specified  by  pointing  to  two  vertices  and  polygons  are  defined  by  indicating  a 
minimum  of  3 vertices  to  a maximum  of  NPVERT  vertices. 


Elements  can  be  added  from  any  of  the  input  devices.  The  command 

[joystick] 

SET  (TABLET  [ (default  = KEYBOARD) 

{ KEYBOARD ) 

sets  the  default  input  device.  At  the  start  of  program  execution,  the 
keyboard  is  the  data  input  device.  To  add  data  from  a different  device,  SET 
^ must  be  used  before  ADD. 

If  the  attributes  of  new  edges  or  polygons  are  to  be  different  than  the 
default  characteristics,  the  command 

SELECT 

must  be  used  before  the  ADD  command.  SELECT  allows  the  specification  of  the 
line  width,  color,  polygon  fill  type  and  a user  specification  parameter,  the 
fourth  element  in  ESPEC  and  NSPEC.  These  new  values  then  become  the  default 
attributes . 

Elements  are  deleted  from  the  file  with  the  command 

(VERTEX  ) 

EDGE  [ (default  = VERTEX) 

polygon) 

When  a vertex  is  deleted,  any  edge  or  polygon  containing  that  vertex  is  also 
deleted.  It  should  be  noted  that  the  vertex  is  not  deleted  from  the  permanent 
data  file;  instead,  this  point  is  marked  with  a flag  to  indicate  deletion  from 
the  user  space.  In  order  to  remove  vertices  from  the  data  file,  the 
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SQUEEZE 


command  is  used.  All  "flagged"  vertices,  along  with  any  vertices  in  the  user 
space  which  are  not  used  by  an  edge  or  a polygon,  are  deleted  from  the  data 
file  by  SQUEEZE.  When  the  DELETE  command  is  used  for  polygons  and  edges, 
however,  these  elements  are  removed  from  the  user  space  and  the  data  file. 

Once  added  to  the  user  space,  the  elements  can  be  modified.  Elements  are 
moved  to  new  locations  through  the  command 

(VERTEX  j 

MOVE  {edge  j (default  = VERTEX) 

( POLYGON  ) 

A vertex  can  be  moved  by  specifying  its  new  (x,y,z)  coordinates.  Alternative- 
ly, a single  vertex  or*  a group  of  vertices  can  be  moved  a distance  given  by  an 
(x,y,z)  displacement  vector.  MOVE  EDGE  allows  a single  edge  or  a group  of 
edges  to  change  location  by  a specified  (x,y,z)  distance.  Polygons  are  moved 
in  the  same  manner  as  edges.  "MOVE"  makes  new  verticies  when  moving  edges  or 
polygons.  In  addition,  duplicates  of  elements  can  be  created  with 

f EDGE  ) 

DUPLICATE  polygon  (default  = VERTEX) 

The  new  elements  are  positioned  at  the  designated  displacement  from  the 
original  position. 

In  addition  to  modifying  portions  of  the  model,  the  entire  structure  can 
be  transformed.  The  model  is  moved  to  another  part  of  the  user  space  with  the 
command 

TRANSLATE 

accompanied  by  an  (x,y,z)  displacement  vector.  A rotation  of  the  model  about 
a specified  point  (default  is  the  body  center  of  gravity  for  the  model)  is 
possible  with 

ROTATE 

The  rotations  occur  about  axes  parallel  to  the  x-,  y-,  or  z-axes  of 
coordinate  system.  The  axis  and  angle  of  rotation  are  specified.  The 
structure  is  scaled  about  its  center  point  by 

SCALE 

which  requires  the  input  of  a positive  scale  factor.  If  the  scale  factor  is 
greater  than  one,  the  model  will  be  magnified.  If  the  factor  is  between  zero 
and  one,  the  structure  will  be  reduced.  Each  scaling,  rotation,  and 
translation,  along  with  the  order  of  application,  is  recorded  in  a matrix 
called  the  transformation  matrix.  This  matrix  contains  the  information  needed 
to  directly  convert  the  structure  from  the  original  configuration  to  the  final 
position  determined  by  the  series  of  transformations. 
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A listing  of  the  elements  in  the  work  file  or  of  the  transformation 
matrix  can  be  obtained  at  the  terminal  with 


LIST 


VERTEX 

EDGE 

POLYGON 

MATRIX 


(default  = VERTEX) 


Heading  the  vertex  list  are  the  world  and  window  coordinates  of  the  work 
file.  The  (x,y,z)  coordinates  of  a designated  group  of  vertices  follow. 
These  vertices  are  listed  by  numbers;  missing  numbers  correspond  to  vertices 
which  were  removed  from  the  user  space  with  DELETE.  The  LIST  EDGE  command 
also  requires  the  specification  of  a group  of  edges.  Each  edge’s  number  and 
endpoint  vertices  are  listed  on  a row.  Similarly,  the  polygon  numbers  and 
component  vertices  are  listed  for  a group  of  polygons  by  the  LIST  POLYGON 
command.  Finally  the  transformation  matrix  is  displayed  with  LIST  MATRIX. 


The  lists  can  be  sent  to  the  printer  instead  of  the  terminal  with  the 
command 


PRINT 


VERTEX 

EDGE 

' POLYGON 
ALL 

( MATRIX 


(default  = ALL) 


The  PRINT  commands  produce  lists  in  the  same  format  as  the  corresponding  LIST 
commands.  However,  groups  of  elements  are  not  specified  by  the  user.  The 
PRINT  element  command  lists  the  first  through  the  last  "element"  stored  in  the 
work  file.  The  additional  command,  PRINT  ALL,  lists  the  world  and  window 
coordinates;  all  of  the  vertices,  edges,  and  polygons;  and  the  transformation 
matrix. 


The  contents  of  the  work  file  can  be  displayed  graphically.  At  the  start 
of  program  execution,  the  output  device  for  the  display  defaults  to  the 
Lexidata.  A different  device  is  selected  with 


fCALCOMP 
PRINTER 
LEXIDATA 
CONSOLE 


(default  = LEXIDATA) 


The  specified  device  becomes  the  new  default  for  graphical  display. 


If  the  output  device  has  associated  hard  copies,  these  copies  can  be 
generated  with 


COPY 


ON  j 
OFF) 


(default  = OFF) 


After  COPY  ON  has  been  entered,  a specified  number  of  hard  copies  of  each 
subsequent  graphics  diplay  will  be  produced.  To  discontinue  this  automatic 
duplication,  COPY  OFF  must  be  entered.  Note  that  the  copy  switch  is  in  the 
OFF  position  at  the  start  of  program  execution. 
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The  model  is  displayed  with 


DISPLAY 


(VERTEX 
EDGE 
POLYGON 
ALL 


(default  = ALL) 


If  the  ouptut  device  is  a screen,  the  screen  is  cleared  before  the  display  is 
generated.  Only  the  elements  within  the  window  are  displayed.  DISPLAY  VERTEX 
plots  the  model's  vertices  and  labels  each  vertex  with  its  number.  DISPLAY 
EDGE  or  DISPLAY  POLYGON  draws  the  models'  edges  or  polygons,  respectively 
without  numbering  them.  All  edges  and  polygons  are  shown  with  DISPLAY  ALL.  A 
screen  can  be  cleared  with 


ERASE 

Otherwise,  the  image  will  remain  on  the  screen  until  DISPLAY  is  used  again  or 
until  termination  of  the  program. 

The  field  of  view  for  a display  is  altered  with 

FIELD 

The  point  of  observation  can  be  moved  relative  to  the  x-y  plane  of  the  user's 
system.  A distance  of  zero  places  the  observer  at  the  origin  of  the 
coordinate  system.  A positive  distance,  d,  positions  the  observer  d units  on 
the  negative  z-axis.  The  perspective  of  the  display  changes  as  the  viewer's 
distance  is  altered.  In  addition,  the  angle  of  view  can  be  changed.  This 

angle,  originating  at  the  observer  and  bisected  by  the  z-axis,  determines  the 

scope  of  vision.  For  instance,  as  the  angle  is  decreased,  the  scope  of  vision 

becomes  narrower.  At  the  start  of  program  execution,  the  observer  is 

positioned  10,000  units  from  the  origin  and  the  angle  of  view  is  90°. 

At  times  it  is  useful  to  modify  a structure  throughout  a sequence  of  frames. 
The  number  of  frames  and  the  changes  desired  are  specified  with 

ANIMATE 

The  structure  can  be  translated,  scaled  about  its  center,  or  rotated  about  a 
particular  point.  Edges  and  polygons  may  be  moved.  The  observer  can  be  moved 
along  the  z-axis.  Any  combination  of  these  modifications  is  possible.  Note 
that  ANIMATE  only  receives  the  parameters  for  each  change.  The  sequence  of 
frames  is  viewed  with  DISPLAY. 

Some  transformations  may  cause  the  model  to  be  moved  outside  the 
window.  If  the  location  of  the  structure  becomes  unknown,  there  may  be 
difficulties  in  retrieving  the  model.  The  model  is  found  with 

AUTO 

The  window  and  the  observer  are  automatically  moved  so  that  the  entire  model 
can  be  seen.  As  a result  of  AUTO,  the  scale  of  the  model  may  not  be  optimum 
for  viewing.  This  situation  is  easily  modified  with  SCALE  and  FIELD. 
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The  commands  and  the  user's  reponses  to  the  subsequent  prompts  do  not 
have  to  be  entered  at  the  console.  The  input  device  is  changed  to  a specified 
file  with 


INPUT 

All  input  is  read  from  this  file  until  another  input  file  is  specified.  The 

EXIT 

command  changes  the  input  device  to  the  console. 

Finally,  the  program  is  terminated  with 
END 

While  the  program  is  running,  the 

HELP 

command  is  used  to  list  all  the  commands  together  with  a brief  description  of 
them. 


6.2  TITLES 

The  TITLES  program  is  used  to  create  and  modify  a series  of  colored 
pictures  consisting  of  character  strings,  lines,  and  circles.  The  strings  are 
positioned  on  the  screen  by  means  of  a joystick.  Characters  from  any 
combination  of  the  24  character  sets  (see  Appendix  C)  are  used  to  form  a 
string.  Lines,  circles,  and  bullets  also  may  be  added  to  the  picture. 

Elements  are  added  in  various  colors  and  sizes.  Once  the  pictures  (usually 
called  slides  ) have  been  created,  hard  copies  may  be  generated.  TITLES  is 
commonly  used  to  produce  slide  presentations. 

At  the  start  of  program  execution,  there  is  the  option  of  accessing  an 
existing  data  file  or  composing  a new  file.  The  desired  option  is  specified 
by  entering  the  filename,  or,  to  indicate  the  creation  of  a new  file,  by 
hitting  the  <RETURN>  key. 

Once  an  existing  file  has  been  read,  the  user  is  asked  for  a command  with 
the  prompt  FUNCTION=.  Prompts  are  given  when  needed.  If  the  file  is  new,  the 
command  defaults  to 


NEW, 

a new  slide  is  created  and  added  to  the  work  file.  The  default  color  and 
character  set  for  the  text  on  this  slide  is  specified.  Lines  of  text  are 
entered  and  then  positioned  with  the  cursor.  Colors  and  character  sets  may  be 
changed  within  a character  string  by  means  of  control  sequences.  Control 
sequences  are  also  used  to  add  subscripts  and  superscripts  and  to  change  the 
justification  of  the  text  (see  Appendix  B).  These  attributes,  however,  are 
returned  to  the  default  values  for  the  next  Line  of  text. 
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Once  a character  string  is  placed  on  the  screen,  modifications  may  be 
made.  The  string  may  be  deleted,  moved,  centered  on  the  line,  and  scaled. 

Note  that  the  character  size  resulting  from  a scaling  becomes  the  default  size 
for  all  characters  subsequently  entered.  This  process  of  adding  and  modifying 
text  is  continued  until  the  <RETURN>  key  is  entered  instead  of  text 
characters.  At  this  point,  the  user  is  informed  of  the  number  of  slides  in 
the  work  file. 

Slides  are  modified  in  several  ways.  Lines  of  text  can  be  corrected  one 
line  at  a time  with  the  command 

COEIRECT 

A character  string  can  be  deleted,  moved,  centered  on  the  line  and  scaled. 

When  all  corrections  have  been  made  to  one  line  of  text,  the  process  is 
repeated  for  the  remaining  character  strings  on  the  slide. 

Various  elements  may  be  added  to  a slide.  Text  is  added  with  the  command 

ADD 

The  default  color  and  character  set  are  selected.  Lines  of  text  are  entered 
and  modified  as  with  the  NEW  command.  Other  types  of  elements  are  drawn  in 
specified  colors  and  at  given  locations.  Bullets  (filled  circles)  are  added 
with  the  command 

BULLET 

A straight  line  is  drawn  between  two  specified  points  with 

LINE 

Finally,  with  a center  point  and  a radial  distance  designated,  a circle  is 
added  to  the  slide  with 

CIRCLE 

Once  drawn,  each  element  may  be  corrected  in  the  usual  manner.  It  may  be 
deleted,  moved,  centered,  or  scaled. 

Specified  slides  in  the  work  file  may  be  displayed  on  the  Lexidata  with 
the  command 

VIEW 

Hard  copies  are  generated  with  the  command 

PROCESS 

Slides  are  specified  along  with  the  desired  number  of  copies  of  each  slide. 

The  delay  time  for  the  hard  copy  device  is  changed  with 
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DELAY 


and  the  work  file  may  be  written  and  saved  as  a data  file  with  the  command 

SAVE 

If  the  work  file  is  new,  a filename  is  specified  by  the  user.  Otherwise,  the 
slides  are  automatically  written  to  the  file  last  accessed.  In  order  to 
access  another  data  file,  the 

REREAD 


command  is  used. 

The  various  character  sets  and  colors  may  be  referenced.  The  command 
SET 

displays  a specified  character  set.  Each  set  has  been  arranged  to  correspond 
to  the  96  displayable  ASCII  characters.  When  adding  text  to  a slide,  a 
desired  character  is  placed  in  the  character  string  by  entering  the 
corresponding  ASCII  character.  The  command 

COLORS  (default  = 1) 

displays  all  the  available  colors  in  rows.  The  colors  are  numbered  to 
correspond  with  the  rows.  The  color  in  the  top  row  is  color  number  one,  the 
next  row  is  color  number  two,  and  so  on. 

The  two  remaining  commands  are  HELP  and  END.  The  commands  are  listed 
(but  not  described)  with 

HELP 

Finally,  the  program  is  terminated  with 

END 


6.3  ADDMAP 

This  is  a structure  manipulation  program  to  add  pieces  of  structure  file 
together.  The  commands  are  similar  to  those  found  in  BUILD  and  TITLE.  There 
are  some  additional  commands  to  manipulate  the  individual  pieces.  The 
commands  are 

SET,  NEW,  GET,  WINDOW,  ADD,  SAVE,  DISPLAY,  SPECS,  DRAG,  GROUP,  TRANSLATE, 
ROTATE,  SCALE,  FIELD,  DEVICE,  HELP  and  END. 

The  only  commands  described  here  are  those  which  differ  from  the  explanation 
in  sections  6.1  and  6.2.  The  implementation  of  several  commands,  such  as  SET 
and  GET,  differs  in  BUILD  and  TITLES,  but  accomplishes  the  same  task. 

The  special  commands  to  deal  with  adding  structures  involve  those  which 
force  actions  on  only  a portion  of  the  total  file.  These  are  NEW,  DRAG  and 
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GROUP. 


In  general,  all  manipulation  commands  are  applied  to  all  extant 
vertices.  However,  as  pieces  are  added  with  repeated  GET  requests,  a table  is 
maintained  which  points  to  each  of  these  GROUPS  of  vertices,  polygons,  edges 
and  polylines.  In  order  to  apply  an  operation  to  a single  group,  the  command, 

GROUP 

is  used.  The  response  will  be  an  integer  from  zero  to  a number  no  larger  than 
the  number  of  GETs  which  have  been  applied.  If  0 is  entered,  then  all  groups 
are  affected.  If  a non-zero  number  is  used,  then  only  that  group  is 
affected.  An  error  is  returned  and  the  request  repeated  if  a negative  integer 
or  a number  which  exceeds  the  maximum  number  of  groups  is  entered. 

DRAG 

is  similar  to  translate,  but  is  done  by  a pointing  device.  When  this  command 
is  invoked,  a point  to  drag  is  specified.  This  is  the  initial  point.  Then  a 
final  or  destination  position  is  requested.  The  action  is  to  move  the 
appropriate  vertices  by  this  change.  Essentially,  it  allows  the  user  to 
specify  a translation  without  knowing  the  actual  coordinates  of  a map  position 
on  the  screen.  This  program  maintains  the  group  designations  internally 
whereas  BUILD  does  not.  The  grouping  is  given  on  the  third  line  (image)  of 
the  structures  file. 

The  command 


NEW 

resets  pointers  and  counters  and  is  equivalent  to  restarting  the  program. 
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APPENDIX  A 


The  following  is  a description  of  each  routine,  together  with  its 
arguments.  All  routines  are  listed,  although  emphasis  is  on  the  higher  level 
routines.  For  the  "hackers",  low  level  routines  are  included  since  special 
effects  are  sometimes  desirable.  The  usual  FORTRAN  convention  for  integer  and 
real  (floating)  numbers  is  maintained.  Type  is  given  only  for  arrays  and 
character  variables. 
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ALABEL 


Purpose:  to  draw  a character  string  with  an  aspect  ratio  of  4/3  given  the 

width  and  an  angle  of  rotation. 

Usage;  Call  ALABEL  (CHARS,  XI,  Yl,  X2,  Y2,  ANGLE) 

Description  of  Parameters: 

CHARS  - CHARACTER  * 1 ARRAY  - character  string  to  be  drawn 


XI,  Yl 

- lower  left  starting  point 

of  the  string 

X2 

- X coordinate  of  the  right 

ending  point  of 

the  string 

Y2 

- not  used 

ANGLE 

- angle  (radians)  by  which 

to  rotate  the 

string.  - [A  positive  (negative)  angle  causes  a 
counter-clockwise  (clockwise)  rotation  about 
the  lower  left  starting  point. 

Control  Sequences;  See  Appendix  B 

Method:  This  routine  calls  the  subroutine  WDCOUNT  to  determine  if  the  string 

contains  characters.  If  characters  exist,  LABEL  calculates  the  space 
size  of  the  characters  in  order  to  create  a 4/3  aspect  ratio. 

Finally,  the  subroutine  WDDRAW  is  called  to  plot  the  text. 
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BOXPLT 


Purpose:  to  draw  a rectangle  given  the  endpoints  of  one  of  the  diagonals. 

Usage:  Call  BOXPLT  (XI,  Yl,  X2,  Y2) 

Description  of  Parameters: 

XI,  Yl  - coordinates  of  lower  left  corner  of  the  box 

X2,  Y2  - coordinates  of  the  upper  right  corner  of  the  box 

Method:  The  routine  determines  the  endpoints  of  each  side  of  the  rectangle. 

These  endpoints  are  placed  in  an  array  and  sent  to  the  subroutine 
LINES  which  plots  the  four  sides. 
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CHPLOT 


Purpose: 

to  draw  a specified  hardware  character  centered  at  selected  points 
in  an  array. 

Usage: 

Call  CHPLOT  (X,  Y,  CHAR,  11,  12,  13) 

Description  of  Parameters: 


X,  Y 

- ARRAY  - points  at  which  to  plot  the  character 

CHAR 

- CHARACTER  * 1 - character  to  be  plotted 

11 

- index  of  first  point  to  plot 

12 

- Increment  at  which  points  are  to  be  selected  to 
plot 

13 

- index  of  last  point  to  plot 

Method: 

The  routine  selects  the  points  at  which  to  plot  the  character.  The 
subroutine  SYMBOL  is  called  to  draw  the  character  at  each  of  these 
chosen  points. 
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CHRSET 


Purpose:  to  change  the  default  character  set 

Usage:  Call  CHRSET  (N) 

Description  of  Parameters: 

N - number  (1-24)  corresponding  to  a character  set 
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CHRSIZ 


Purpose:  to  set  the  size  of  the  hardware  character 

Usage:  Call  CHRSIZ  (CHFRZ,  GCHFRZ) 

Description  of  Parameters: 

CHFRZ  - a fraction  specifying  the  size  of  the  characters  relative  to 
the  screen  (default  = .03) 

GCHFRZ  - a fraction  specifying  the  size  of  the  characters  relative  to 
the  variables  YIR  and  Y2R  in  subroutine  GRAFIT 
(default  = .04) 
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CIRCLE 


Purpose : 

to  draw  a circle  of  a given  radius  about  a specified  center  point. 

Usage: 

Call  CIRCLE  (X,Y,R) 

Description  of  Parameters: 


X,Y 

- center  of  the  circle 

R 

- radius  of  the  circle 

Method: 

The  routine  generates  commands  to  transform  the  points  from  the  user 
space  to  the  raster  space.  It  then  generates  commands  to  plot  a 
circle  centered  at  the  point  (X,Y)  with  a radius  of  R. 

« 
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COLOR 


Purpose:  to  define  the  color  for  drawing 

Usage:  Call  COLOR(N) 

Description  of  Parameters: 

N - the  number  corresponding  to  a desired  color 

Method:  This  command  is  Ignored  for  the  printer  and  Tektronix.  For  the  other 

devices,  an  integer  is  normalized  between  1 and  NUMCOLOR,  where 
NUMCOLOR  is  the  number  of  colors  the  device  can  display.  The  Calcomp 
and  Lexldata  possess  4 and  16  colors,  respectively.  The  numbers  are 
normalized  by  modular  arithmetic  and  numbers  less  than  1 are  set 
equal  to  1 : 


COLOR  = M0D(N-1,  NUMCOLOR)  + 1 
COLOR  = MAX0(COLOR,  1) 
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CONTUR 


Purpose:  to  perform  surface  plotting 

Usage:  Call  CONTUR  (F,  TEST,  NX,  NY,  FL) 

Description  of  Parameters: 


F 

- ARRAY  (NX,  NY)  - real  values  of  the  function  to  be  contoured 

TEST 

- ARRAY  (NX,  NY)  - user  supplied  scratch  array  having  the  same 

dimension  as  F 

NX 

- range  and  dimension  of  i in  F(i,j) 

NY 

- range  and  dimension  of  j in  F(i,j) 

FL 

- value  of  F(i,j)  for  contouring 

Method: 

Contours  are  plotted  by  looking  at  a projection  of  the  function 
F(I,J)  and  determining  if  the  function  crosses  the  contouring 
interval  within  their  box.  Six  interpolations  are  done.  First  I to 
I+l,  then  J to  J+1  parallel  crossings  are  considered.  Finally,  the 
four  cases  of  diagonal  crossings  are  considered  by  triangular  inter- 
polation of  each  tesselation  of  the  box  by  the  corner  points  with  the 
center.  The  corner  points  are  considered  in  pairs  moving  counter- 
clockwise around  the  projected  box. 
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DEFINE 


Purpose:  to  define  the  correspondence  between  the  user's  window  and  the 

device's  world  space 

Usage:  Call  DEFINE  (XI,  Yl,  X2,  Y2) 

Description  of  Parameters: 

XI,  Yl  - coordinates  of  the  window's  lower  left  vertex 
X2,  Y2  - coordinates  of  the  window's  upper  right  vertex 

Method:  The  differences  X2-X1  and  Y2-Y1  are  checked.  If  either  of  the 

differences  is  equal  to  zero,  the  difference  is  set  equal  to  one.  The 
routine  then  calculates  the  transformation  which  maps  objects  from 
the  user's  window  to  the  device's  world  space.  The  viewport  defaults 
to  the  entire  viewing  surface. 
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DELAY 


Purpose: 

to  delay  for  hard  copy  units 

Usage : 

Call  DELAY(N) 

Description  of  Parameters: 


N - 

the  number  of  seconds  to  delay 

Method: 

This  routine  calls  the  system  routing  WAIT  for  the  Tektronix  and.  the 
Matrix  camera. 
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DEVICE 


Purpose;  to  initialize  a device 
Usage:  Call  DEVICE(N) 

Description  of  Parameters : 

N - defines  a device 
= 1 - Calcomp 
= 2 - Printer 
= 3 - Lexldata 
= 4 - Textronix  Console 
= 5 - Empty  Slot 


Method:  If  a device  is  already  open,  execution  of  the  program  is  terminated. 

Otherwise,  the  desired  (device)  file  is  connected  to  a unit.  The 
device  defaults  to  the  printer  if  the  specified  number  "n"  does  not 
correspond  to  an  existing  device. 
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DEVINP 


Purpose : 

to  get  a coordinate  triplet  from  an  input  device. 

Usage : 

CALL  DEVINP  (INPUT,  MASK,  STATUS,  X,  Y,  Z) 

Description  of  Parameters: 


INPUT 

- input  device:  1 = joystick;  2 = tabet;  3 = keyboard. 

MASK 

- button  select  - by  power  of  2. 

1 = button  1 

2 = button  2 
4 = button  3 

8 = button  4 

STATUS  - returns  a value  corresponding  to  MASK  for  the  button  pushed. 
X,Y,Z  - cordlnate  values  returned.  For  two-dimensional 
devices,  Z is  always  0. 
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ENDFRM 


Purpose:  to  close  the  graphics  device 

Usage:  Call  ENDFRM 

Method:  Closes  logical  units  associate  with  DEVICE,  Normally  these  are  units 

7,  8,  and  9.  This  routine  does  not  empty  the  I/O  buffer  but  does 
send  disconnect  sequences  and,  for  screen  devices,  erases  the  screen. 


ENUMBR 


Purpose : 

to  draw  a real  decimal  number  expressed  with  powers  of  10  such  that 
the  mantissa  is  between  1 and  10,  i.e.  , y^lO*^  where  1 < |y|  < 10 

Usage: 

Call  ENUMBR  (XNUMBR,  XI,  Yl,  X2,  Y2) 

Description  of  Parameters: 

XNUMBR  - number  to  be  plotted  in  exponential  format 

XI,  Y1  - starting  point  (lower  left  corner)  of  the  first  character  drawn 
X2,  Y2  - terminating  point  (upper  right  corner)  of  the  last  character 


Method: 

drawn 

A real  number,  not  equal  to  zero,  is  normalized  between  0 and  10. 
Then  ENUMBR  plots  this  portion  as  scaled  by  the  starting  and  termi- 
nating points  (XI,  Yl)  and  (X2,  Y2).  The  characters  "10*"  are  then 
plotted,  followed  by  a superscript  containing  the  normalizing  power 
of  10. 
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ERASE 


Purpose:  to  erase  the  screen 
Usage:  Call  ERASE 

Method:  This  command  is  ignored  for  the  Calcomp.  For  display  devices  a 

simple  erase  sequence  is  sent. 
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FILTYP 


Purpose:  to  define  the  appearance  of  the  interior  of  polygons  and  circles 

Usage:  Call  FILTYP(N) 

Description  of  Parameters: 

N - the  number  corresponding  to  a desired  fill  type 

Method:  There  are  9 fill  types  (0-8)  for  devices  supporting  filling  patterns. 

The  current  devices,  except  for  the  Calcomp,  support  these  patterns. 
Figure  (4)  shows  the  fill  pattern  numbered  from  0 on  the  lower  left 
to  8 at  the  upper  right  of  the  figure. 


figure  4 
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FNUMBR 


Purpose:  to  draw  a real  number  in  FORTRAN  F format 

Usage:  Gall  FNUMBR  (X,  Y,  DX,  DY,  SX,  SXY,  SY,  XNUMBR,  IWIDTH,  NDIGIT) 

Description  of  Parameters: 

X,  Y - starting  point  (lower  left  corner)  of  the  first  character  to  be 
drawn 

DX  - increment  added  to  the  X-coordinate  for  each  character  drawn 

DY  - increment  added  to  the  Y-coordinate  for  each  character  drawn 

SX  - X space  size  for  the  characters 

SXY  - slant  modifier  for  characters 

SY  - Y space  size  for  the  characters 

XNUMBR  - number  to  be  plotted  in  F format 

IWIDTH  - total  width  of  field  including  decimal  point 

NDIGIT  - number  of  places  to  the  right  of  the  decimal  point  to  be  drawn 

Method:  The  input  "XNUMBR"  is  scaled  to  include  the  specified  number  of 

places  to  the  right  of  the  decimal  point.  Each  digit  in  the  number 
is  converted  to  a literal  character.  Leading  zeros  are  converted  to 
blanks  and  the  decimal  point  is  inserted  if  NDIGIT  is  greater  than 
zero.  The  subroutine  WDDRAW  is  called  to  plot  the  literal  data 
string.  The  parameters  X,  Y,  DX,  DY,  SX,  SXY,  and  SY  have  the  same 
meaning  as  in  WDDRAW. 
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FRAME 


Purpose:  to  force  out  the  contents  of  the  buffer 

Usage:  Call  FRAME 

Method:  This  call  should  be  used  to  terminate  each  series  of  graphics 

sequences.  It  is  used  to  insure  that  the  I/O  buffers  are  empty  and 
to  synchronize  the  timing  of  the  I/O  channel. 
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GRAFIT 


Purpose:  to  set  up  a graph  (X  and  Y axis)  for  plotting  data 

Usage:  Call  GRAFIT  (NPLT,  XI,  X2,  XIR,  X2R,  XXI,  XX2 , Yl,  Y2,  YIR,  Y2R,  YYl, 

YY2,  XTIT,  NDVX,  YTIT,  NDVY) 


Description  of  Parameters: 


NPLT 
XI,  X2 
X1R,X2R 


- number  of  the  plot  referenced  (up  to  four  graphs  may 
be  placed  on  one  graph) 

- labels  of  X-axis  minimum  and  maximum,  respectively. 
(The  literal  string  'NONE'  produces  no  label.) 

- user  space  value  of  X-axis  minimum  and  maximum, 
respectively 


XXI, XX2  - minimum  and  maximum  values,  respectively,  of  X in 

data  to  be  plotted 

Yl,  Y2  - labels  of  Y-axis  minimum  and  maximum,  respectively. 

(The  literal  string  'NONE'  produces  no  label.) 


Y1R,Y2R  - user  space  value  of  y-axis  minimum  and 

maximum,  respectively 

YY1,YY2  - minimum  and  maximum  values,  respectively,  of  Y in  data 

to  be  plotted. 


XTIT  - char 


- title  for  X-axis  (less  than  30  characters  and  terminated 

by  'I.') 


NDVX 


- number  of  Intervals  to  be  drawn  on  X-Axis 


YTIT  - char  - title  for  Y-axis  (less  than  30 

characters  and  terminated  by  * j • ' ) 

NDVY  - number  of  intervals  to  be  drawn  on  Y-axis 


There  are  three  additional  entry  points:  PLOTCH,  PLOTLN  and  GRISET. 

PLOTCH  (NPLT,  X,  Y,  NP  CHAR)  - where  NPLT  is  the  corresponding 

plot  number 

PLOTLN  (NPLT,  X,  Y,  NP)  - (See  above),  X and  Y are  coordinate 

arrays,  NP  is  the  number  of  points  to 
plot  (or  connect)  and  CHAR  is  a 
character  in  CHARACTER  *1  format 

GRISET  (XL,  YL,  XR,  YT)  - see  DEFINE 
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HDCOPY 


Purpose:  to  generate  a hard  copy 

Usage:  Call  HDCOPY 

Device  Associated  Hard  Copy 

Calcomp  - 

Printer  - 

Lexidata  Camera 

Tektronix  Activates  screen  copy  unit 

Method:  This  command  is  ignored  for  the  Calcomp  and  the  printer. 
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HHDRAW 


Purpose:  to  draw  a particular  character  of  a specified  character  set 

Usage:  Call  HHDRAW  (X,  Y,  SX,  SXY,  SY,  ICHAR,  NSET,  lERR) 

Description  of  Parameters: 


X,  Y 

- starting  point  (lower  left)  of  the  character  to  be  plotted 

SX 

- X space  size  for  character  (user  coordinate  system) 

SXY 

- slant  modifier  for  character 

SY 

- Y space  size  for  character  (user  coordinate  system) 

ICHAR  - index  to  specify  characters  within  the  chosen  set 


NSET 

- number  specifying  a particular  character  set 

lERR 

- error  flag 

= 0 - no  errors 

= 1 - error  in  accessing  set  or  character 

Method: 

If  the  desired  character  is  from  the  hardware  set,  then  the 
subroutine  SYMBOL  is  called  to  plot  the  character.  For  characters 
from  other  sets,  HSETS  is  called  to  place  the  character's  coordinates 
and  pen  values  in  arrays  and  then  LINES  is  called  to  plot  the 
character  as  a set  of  connected  strokes. 
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lOWAIT 


Purpose:  to  put  a pause  in  the  program 

Usage:  Call  lOWAIT  (N) 

Description  of  Parameters: 

N - number  of  milliseconds  to  pause 
Method:  This  routine  calls  the  system  routine  WAIT. 
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LABEL 


Purpose:  to  draw  a character  string  of  a specified  width  and  height  (i.e.,  a 

rectangular  area)  at  a specified  location 

Usage:  Call  LABEL  (CHARS,  XI,  Yl,  X2,  Y2,  ANGLE) 

Description  of  Parameters: 

CHARS  - CHARACTER  * 1 ARRAY  - character  string  to  be  drawn 


XI,  Yl 
X2,  Y2 
ANGLE 


- lower  left  starting  point  of  string 

- upper  right  ending  point  of  string 

- angle  (radians)  by  which  to  rotate  the 
string.  [A  positive  (negative)  angle  causes 
a counter-clockwise  (clockwise)  rotation 
about  the  point  (XI,  Yl)]. 


Control  Sequences:  See  Appendix  B 

Method:  This  routine  calls  the  subroutine  WDCOUNT  to  determine  if  the  string 

contains  characters.  If  characters  exist,  LABEL  calculates  the  space 
size  of  the  characters  and  calls  the  subroutine  WDDRAW  to  plot  the 
text. 
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LINE 


Purpose:  to  draw  a line  between  two  given  points 
Usage:  Call  LINE  (XI,  Yl,  X2,  Y2) 

Description  of  Parameters: 

XI,  Yl  - coordinates  of  first  point 
X2,  Y2  - coordinates  of  second  point 

Method:  The  routine  transforms  the  points  from  the  user  space  to  the  raster 

space.  Subroutine  PUTLNV  is  then  called  to  generate  a line  segment 
to  connect  the  points. 
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LINES 


Purpose;  to  draw  lines  between  points  in  an  array 
Usage;  Call  LINES  (XI,  Yl,  X2,  Y2,N) 

Description  of  Parameters; 


XI, 

Yl-array  - starting  coordinates  of  the  lines 

CM 

X! 

Y2-array  - ending  coordinates  of  the  lines 

N 

- number  of  line  pairs;  [Xl(i),  Yl(i)]  [X2(i),  Y2(i)] 

Method; 

The  routine  transforms  the  points  from  the  user  space  to  the  raster 
space.  Subroutine  PUTLNV  is  then  called  to  generate  line  segments  to 
connect  corresponding  points. 
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LINWID 


Purpose:  to  define  the  line  width  for  plotting 

Usage:  Call  LINWID(N) 

Description  of  Parameters: 

N - the  number  of  strokes  when  drawing  a line  - not  Implemented 
for  CALCOMP 

Method:  This  routine  sets  the  number  of  strokes  for  each  line.  (The 

strokes  are  drawn  one  pixel  apart. ) 
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LNPLOT 


Purpose: 

to  draw  lines  between  selected  points  of  an  array 

Usage: 

Call  LNPLOT  (X,  Y,  11,  12,  13) 

Description  of  Parameters: 

X - array  - X coordinates  of  data 
Y - array  - Y coordinates  of  data 


11 

- index  of  first  point  to  be  connected 

12 

- increment  at  which  points  are  to  be  selected  to  plot 

13 

- index  of  the  last  point  in  the  data  array 

Method: 

The  selected  points  are  stored  in  new  arrays  and  the  subroutine  LINES 
is  called  to  generate  each  of  the  lines. 
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NEWFRM 


Purpose:  to  erase  the  screen  and  initialize  a new  frame 

Usage:  Call  NEWFRM 

Method:  Device  dependent  but  in  general  clears  buffers  and  initializes 

pointers. 
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PLYGON 


Purpose;  to  draw  a closed  polygon 
Usage:  Call  PLYGON  (X,Y,N) 

Description  of  Parameters: 


X - 
Y - 
N 

array  - X coordinates  of  the  data 
array  - Y coordinates  of  the  data 

- number  of  vertices  in  the  polygon 

Method: 

The  routine  generates  commands  to  transform  coordinates  from  the  user 
space  to  the  raster  space.  It  then  generates  commands  to  plot  the 
polygon  starting  and  ending  at  vertex  (X(l),  Y(l)). 
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SCALNG 


Purpose:  to  define  the  window  and  the  viewport 

Usage:  Call  SCALNG  (XI,  Yl,  X2,  Y2,  XIH,  YIH,  X2H,  Y2H,  XIS,  YIS,  X2S,  Y2S) 

Description  of  Parameters: 

XI,  Yl  - lower  left  corner  of  the  window  (user  coordinates) 

X2,  Y2  - upper  right  corner  of  the  window  (user  coordinates) 

XIH,  YIH  - lower  left  corner  of  viewport  (device  coordinates) 

X2H,  Y2H  - upper  right  corner  of  viewport  (device  coordinates) 

XIS,  YIS  - lower  left  corner  of  world  (world  coordinates) 

X2S,  Y2S  - upper  right  corner  of  world  (world  coordinates) 

Method:  Calculates  the  transformations  to  map  objects  from  the  user's  window 

into  the  device's  world  and  then  into  the  viewport. 
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SETDEV 


Purpose:  to  change  logical  units 

Usage:  Call  SETDEV  (Nl,  N2) 

Description  of  Parameters : 

Nl  - logical  unit  for  graphics  output  (0-  ; default  = 7) 

N2  - logical  unit  for  diagnostic  output  (1-  ; default  = 0) 
Default  Device  Assignments : 


LU 

Result 

Diagnostics 

0 

no  output 

Graphics 

7 

normal  - assigned 

Camera* 

8 

assigned  with  Lexidata 

Character  set 

0 

unit  zero-assigned 

Cal comp 

L7: 

RS232  line 

Printer 

PR: 

whatever 

Lexidata 

LEX: 

DMA  (L34DVR  in  system) 

Matrix  camera 

L14: 

RS232 

Tektronix 

C: 

console 

Open  slot 

NULL: 

bit  bucket 

Console  input 

5 

Character  set 

9 (closed 

then  opened) 

Tablet  input* 

8 (closed 

then  opened) 

*Note:  Camera  and  tablet  cannot  be  active  simultaneously 
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SETLUT 


Purpose:  to  set  color  look-up  table 
Usage:  Call  SETLUT 

Method:  The  default  color  look-up  table  is  shown  in  Fig.  (5)  for  the  Lexidata 
8100  . SETLUT  is  not  currently  used.  It  exists  for  users  who  must 
define  look-up  tables  on  other  systems. 


FIGURE  5 
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SURF AC 


Purpose:  construct  and  plot  data  surface 

Usage:  Call  SURFAC  (Z,  NX,  NY,  MODE) 

Description  of  Parameters: 

Z - ARRAY  (NX,  NY)  - data  to  be  plotted  as  a surface 

NX  - dimension  and  range  of  i in  Z(i,j) 

NY  - dimension  and  range  of  j in  Z(i,j) 

MODE  - specifies  the  surface  to  plot 

MODE  = 1:  upper  surface 

MODE  = -1:  lower  surface 

This  subroutine  and  its  entries  construct  and  display  plots  of  a surface 
function  (two  dimensional)  with  the  hidden  lines  removed.  The  appearance  of 
the  plot  is  quite  flexible  and  can  Include  skirts  around  unobservable  por- 
tions. It  is  possible  to  show  just  the  upper  or  just  the  lower  surface,  or 
both  together.  The  surface  must  be  approximately  horizontal. 

SFRAME  (MODE)  - shows  rectangular  parallelpiped  plotting 

region. 

SSKIRT  ( Z, NX, NY, MODE)  - draw  skirts  around  the  plotting  region 

(See  figure  6)  - uses  hidden  surface 
algorithm,  so  should  be  called  last 

SRFSET  (X,Y,  Z MIN,  Z MAX,  NX,  NY)  - initiates  the  plotting  region 


THE  GEOMETRY  FOR  "SURFAC"  PLOTS 
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SYMBOL 


Purpose:  to  draw  a specified  hardware  character  centred  at  a given  point 

Usage:  Call  SYMBOL  (X,  Y,  CHAR) 

Description  of  Parameters: 

X,  Y - location  at  which  to  plot  the  character 

CHAR  - CHARACTER*!  - character  to  be  plotted 

Method:  The  routine  transforms  the  center  point  from  the  user  space  to  the 

raster  space.  Subroutine  PUTCH  is  then  called  to  generate  the 
commands  to  plot  the  character. 
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VOLUME 


Purpose:  To  draw  a two -dimens ion  projection  of  a 3-dimensional  array; 

simulates  effect  of  "3D" 


Usage:  Call  VOLUME  (MODE,  F,  NX,  NY,  NZ,  CLEVE,  NCL,  T,  NT) 

Description  of  Parameters: 


F - ARRAY  (NX,  NY,  NZ) 

NX 

NY 

NZ 

T - ARRAY  (NT,  NT) 

NT 

CLEVE 

MODE 

ABS(MODE)  = 1: 

ABS(MODE)  =-2: 

MODE  < 0: 

MODE  > 0: 

NCL 


three-dimensional  figure  to  be  plotted 

range  and  dimension  of  i in  F(i,j,k) 

range  and  dimension  of  j in  F(i,j,k) 

range  and  dimension  of  k in  F(i,j,k) 

plotting  array  (boolean)  to  eliminate  hidden 
lines 

dimension  of  the  array  T:  T(NT,NT) 

contour  surface  level  for  plotting 

specifies  the  surface  to  be  plotted 

plot  contour  level  "CLEVE"  in  each  plane; 
fix  hidden  line  matrix,  T 

find  hidden  line  matrix,  T,  without  plotting 

"outside"  is  less  than  "CLEVE" 

used  when  the  value  of  the  function  on  the 
"outside"  is  greater  than  "CLEVE" 

number  of  pairs  of  (MODE,  CLEVE)  to  be  plotted 


Method:  Contours  a Function  F(See  above)  in  three  dimensions  and  projects  the 

resultant  plots  onto  a two  dimensional  plotting  surface.  Auxiliary 
entries  are 


VOLSET  (X,Y,T,NT)  - initialize  the  plot 

VOLFRM  (MODE)  - MODE  = 0 = corner  vertices 

- Mode  =■  1 = surrounding  box 


- 57- 


A three  dimensional  interpolation  by  triangular  tesselation  is  used  to 
find  the  contour  crossing  points.  The  technqiue  is  similar  to  that  used  in 
CONTUR.  Once  again,  the  hidden  pixel  (frame  buffer)  is  filled  as  the  figure 
is  scanned  back  to  front.  A sample  showing  two  overlapping  spheroids  and  a 
cylinder  is  shown  in  Fig.  7.  The  functions  plotted  are 

Cylinders:  F = (X-10.5)2  + (Y-3.  5)^ 

Sphere  : p,  _ 10 

(X-8)2  + (Y-10.5)2  + (Z-10.5)^ 

V 20 

If  2~  

(X-13)2  + (Y-10.5)2  + (Z-10.5)2 


FIGURE  7 
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WDDRAW 


Purpose;  to  draw  a character  string 

Usage;  Call  WDDRAW  (X,  Y,  DX,  DY,  SX,  SXY,  SY,  CHARS) 

Description  of  Parameters; 

X,  Y - starting  point  of  the  character  string  (the 

string  is  plotted  to  the  right  of  (X,Y)  unless 
otherwise  indicated  by  a control  character) 

DX  - increment  to  be  added  to  the  X-coordinate 

for  each  character  drawn 

DY  - increment  to  be  added  to  the  Y-coordinate 

for  each  character  drawn 

SX  - X space  size  for  characters  (user  coordinate 

system) 

SXY  - slant  modifier  for  characters 

SY  - Y space  size  for  characters  (user  coordinate 

system) 

CHARS  - CHARACTER  * 1 ARRAY  - character  string  to  be  drawn 
Control  Sequences  - See  Appendix  B 

Method;  This  routine  scans  the  string  for  control  characters  and  text 
characters.  When  a text  character  is  found,  the  corresponding 
character  number  is  obtained  by  the  function  IDCHAR.  The  set  number 
assumes  the  default  value  unless  the  number  was  changed  by  a control 
character  within  the  string.  The  routine  also  executes  scaling, 
shifting,  and  rotating  transformations  in  order  to  determine  the 
starting  positions  of  the  characters.  Finally,  the  subroutine  HHDRAW 
is  called  to  plot  the  text  characters. 
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APPENDIX  B 


Control  Sequences  for  WDDRAW,  LABEL,  and  ALABEL 

The  control  sequence  is  "| " followed  by  an  editing  character  which  is  one  of 
the  following; 

L - justify  the  text  to  the  left 

M - center  the  text 

R - justify  the  text  to  the  right  (default) 

Hnn  - change  from  default  character  set  to  set  nn 

U - draw  the  following  characters  in  superscript 

D - draw  the  following  characters  in  subscript 

0 - reset  character  size  and  placement  from  superscript  or  subscript  to 

original  size 

B - backspace  over  last  character  drawn  (works  only  for  one  character, 
multiple  backspaces  will  produce  unpredictable  results. ) 

Cnn  - change  from  the  default  color  to  color  nn 

. - end  of  character  string 


-60 


1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 


APPENDIX  C 


Alphabet 

Style 

Size 

Roman  (Hardware  characters) 

Roman 

Cartographic 

Greek 

Cartographic 

Roman 

Simplex 

Print 

Greek 

Simplex 

Print 

Script 

Simplex 

Print 

Roman 

Complex 

Index 

Greek 

Complex 

Index 

Italic 

Complex 

Index 

Roman 

Complex 

Print 

Greek 

Complex 

Print 

Italic 

Complex 

Print 

Script 

Complex 

Print 

Roman 

Duplex 

Print 

Roman 

Triplex 

Print 

Italic 

Triplex 

Print 

German 

Gothic 

Print 

English 

Gothic 

Print 

Italian 

Gothic 

Print 

Cyrillic 

Complex 

Print 

Miscellaneous 

Miscellaneous 

Miscellaneous 

Miscellaneous 
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APPENDIX  D 


The  following  is  a description  of  each  BUILD  command.  The  prompts 
associated  with  each  command  and  the  format  of  the  user's  response  are  indi- 
cated. 

Note:  When  specifying  a command,  at  least  two  letters  of  each  word  must  be 

entered  (e.g.  AD  PO  means  ADD  POLYGON). 
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1.  ADD 


Elements  are  added  to  the  arrays. 


1.1  ADD  VERTEX 

ENTER  (X,Y,Z)  COORDINATES  AND  SELECT  BUTTON 

BUTTON  1 (KEYBOARD  = '1') — ENTER  VERTEX 
BUTTON  2 (KEYBOARD  = ’2')—  QUIT 

If  the  input  device  is  the  joystick  or  the  tablet,  the  vertex  is  selected  with 
the  picking  implement  and  then  button  1 is  pressed.  If  the  keyboard  is  used, 
the  prompt 

X,Y,Z,IDV=> 

appears.  Three  real  numbers,  followed  by  the  number  1,  are  entered.  These 
numbers  are  separated  by  commas  or  spaces. 

In  both  cases,  the  X,Y,Z  coordinates  of  the  vertex  are  stored  in  the  VERTEX 
array.  Vertices  are  added  until  the  VERTEX  array  is  filled  or  the  user  wants 
to  quit.  In  order  to  quit,  button  2 is  pressed.  At  the  keyboard,  any  three 
numbers,  followed  by  the  number  2,  will  terminate  the  process. 

(Alternatively,  three  commas  followed  by  the  number  2 can  be  entered:  ,,,2) 

1.2  ADD  EDGE 


BY  VERTEX  NO.  (1)  OR  COORDINATES  (2)? 

An  integer  is  entered.  The  number  1 is  entered  if  the  edges  are  to  be 
composed  of  vertices  in  the  VERTEX  array.  The  number  2 is  entered  if  the 
edges  will  be  created  from  new  vertices. 

If  the  first  method  is  chosen,  there  will  be  the  prompt 

ENTER  ENDPOINTS  — 2 VERTEX  NUMBERS 
TO  QUIT  HIT  <RETURN>  OR  ENTER  ’QUIT' 

VETEX  NUMBERS: 

Two  integers,  separated  by  a comma  or  space,  ar  entered.  These  numbers, 
indicating  the  vertices  which  define  the  edge,  are  stored  in  the  EDGE  array. 
The  user  is  prompted  for  another  edge  by 

VERTEX  NUMBERS: 

The  process  continues  until  the  EDGE  array  is  filled  or  the  user  has  finished 
adding  edges. 

If  the  second  method  is  selected  (i.e.  new  vertices  will  be  chosen),  tlie 
user  is  prompted 

ENTER  2 ENDPOINT  COORDINATES: 

BUTTON  1 (KEYBOARD  = '!')  — ENTER  VERTEX  FOR  EDGE 

BUTTON  2 (KEYBOARD  = '2')  — LAST  VERTEX  FOR  EDGE 

BUTTON  3 (KEYBOARD  = '4')  --  QUIT 
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The  vertices  are  specified  as  in  ADD  VERTEX.  The  first  vertex  of  an  edge  is 
followed  by  button  1 ('1*  on  the  keyboard)  and  the  second  vertex  is  followed 
by  button  2 ('2*  on  the  keyboard).  The  new  vertices  are  added  to  the  VERTEX 
array  and  the  new  edge  is  added  to  the  EDGE  array.  Additional  edges  can  be 
created  until  the  VERTEX  or  EDGE  array  is  filled  or  the  user  wants  to  quit. 
Button  3 ('4'  on  the  keyboard)  is  used  to  terminate  the  process. 

Note:  In  both  cases,  if  a newly  formed  edge  exists  in  the  EDGE  array,  this 
element  will  not  be  stored  again.  A message  will  appear  to  inform  the  user  of 
the  condition. 


1. 3 ADD  POLYGON 

Polygons  are  added  in  the  same  manner  as  edges  except  that  at  least  three 
vertices  are  needed  to  define  a polygon.  Also,  there  is  a limit  of  NPVERT 
vertices  for  a polygon.  Polygons  can  be  created  from  existing  vertices  or 
from  new  vertices.  When  entering  new  vertices,  button  1 ('1*  on  the  keyboard) 
is  pressed  after  each  vertex  except  the  last  one  in  a polygon.  This  last 
vertex  is  followed  by  button  2 (’2'  on  the  keyboard).  Finally,  button  3 ('4' 
on  the  keyboard)  terminates  the  process. 

New  polygons  are  added  to  the  POLY  array  provided  that  they  don't  already 
exist  in  the  array.  (Messages  will  appear  to  indicate  existing  polygons.  ) 

Any  new  vertices  will  be  added  to  the  VERTEX  array. 

2.  ANIMATE 

A sequence  of  frames  is  specified.  This  sequence  is  viewed  with  DISPLAY. 
NUMBER  OF  FRAMES 

An  integer  is  entered  to  indicate  the  number  of  frames. 

TOTAL  TRANSLATION  CHANGE  (DX,DY,DZ) 

Three  real  numbers  separated  by  commas,  are  entered.  These  numbers  indicate 
the  total  displacement  of  the  model  in  the  X,Y,Z  directions. 

TOTAL  ROTATION  CHANGE  (DX,DY,DZ) 

Three  real  numbers,  separated  by  commas,  are  specified.  The  model  can  be 
rotated  about  a point  (specified  in  the  next  step)  with  respect  to  X',Y’,Z' 
axes.  These  axes  pass  through  the  specified  point  and  are  parallel  to  the 
X,Y,Z  axes  of  the  coordinate  system.  The  three  numbers  entered  indicate  the 
angles  (in  degress)  of  rotation  about  the  X',Y',Z*  axes.  Note  that  the  rota- 
tions will  be  made  in  he  X',Y*,Z*  order. 

RELATIVE  ORIGIN 

The  point  about  which  rotations  occur  is  specified.  The  center  for  the  model 
is  chosen  by  hitting  the  <RETURN>  key.  A different  point  is  chosen  by 
entering  the  appropriate  X,Y,Z  coordinates.  The  coordinates  are  entered  as 
three  real  numbers  separated  by  commas. 
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DISTANCE  TO  ORIGIN  (DELTA) 


A real  number  indicating  the  total  change  in  the  observer's  position,  is 
entered.  A positive  number  moves  the  observer  along  the  Z-axis  in  the 
negative  direction  (i.e.  away  from  the  viewing  surface).  A negative  number 
causes  the  observer  to  move  in  the  positive  direction  along  the  Z-axis. 

SCALE  FACTOR 

A positive  real  number  is  entered.  If  the  number  is  greater  than  one,  the 
model  is  magnified.  The  model  is  reduced  if  the  number  is  less  than  one. 

MOVE  EDGE(S) 

There  are  several  acceptable  formats  for  the  response: 
n 

n-m 

n- 

n BY  X,Y,Z 
n-m  BY  X,Y,Z 
n-  BY  X,Y,Z 

One  edge  (n)  or  a group  of  edges  (n-m)  may  be  moved.  Note  n-  represents  all 
the  edges  from  n through  the  last  element  in  the  EDGE  array.  n and  m are 
entered  as  positive  integers.  The  relative  displacement  vector  is  specified 
by  the  real  numbers  X,Y,Z.  If  this  displacement  vector  is  not  specified,  the 
user  is  prompted  for  it. 

MOVE  POLYGON(S) 

One  polygon  (n)  or  a group  of  polygons  (n-m)  may  be  moved  by  a distance  X,Y,Z. 
The  specifications  are  entered  in  the  same  format  as  for  MOVE  EDGE(S). 

Note:  Any  of  these  transformations  are  omitted  from  the  animated  sequence  by 

hitting  <RETURN>  after  a particular  prompt. 

3.  AUTO 

The  window  and  observer  are  moved  so  that  the  entire  model  appears  in  the 
field  of  view.  This  command  is  particularly  useful  if  the  location  of  the 
model  outside  the  window  becomes  unknown  to  the  user.  New  parameters  are 
calculated  by  AUTO.  A display  does  not  automatically  follow.  The  DISPLAY 
command  must  be  used  to  view  the  model. 

Note:  The  scaling  of  the  model  may  be  altered  as  a result  of  using  AUTO.  It 

may  be  necessary  to  compensate  for  this  change  by  using  the  SCALE  command. 

4.  COPY 

The  switch  for  hard  copy  of  the  graphics  display  is  set. 
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4.1  COPY  ON 

NO.  OF  COPIES 

An  integer  is  entered  to  indicate  the  number  of  hard  copies  of  each  display  to 
produce.  This  number  defaults  to  one  (1)  if  the  <RETURN>  key  is  pressed. 
Following  each  graphics  display  on  the  output  device,  hard  copies,  associated 
with  this  device,  are  generated. 


4.2  COPY  OFF 

The  automatic  generation  of  hard  copies  after  each  graphics  display  is 
discontinued. 

Note:  At  the  start  of  program  execution,  the  copy  switch  is  set  off. 

5.  DELETE 

Elements  are  deleted  from  the  arrays. 

5.1  DELETE  VERTEX 

Vertices  are  not  actually  deleted  from  the  VERTEX  array.  Instead,  these 
"deleted"  vertices  are  made  unavailable  for  displaying  and  for  constructing 
edges  or  polygons.  Vertices  are  deleted  from  the  array  with  the  SQUEEZE 
command. 

ENTER  VERTEX  LINE  NUMBERS 

HIT  <RETURN>  OR  ENTER  'QUIT'  WHEN  DONE 

VERTEX  n= 

There  are  three  formats  for  entering  vertices: 
n 

n-m 

n- 

where  n and  m are  positive  integers.  One  vertex  (n)  or  a group  of  vertices 
(n-m)  may  be  deleted.  n-  repesents  all  the  vertices  from  n through  the  last 
element  in  the  VERTEX  array.  Once  these  vertices  are  deleted,  the  user  is 
prompted  for  other  vertices  to  delete  with 

VERTEX  n= 

This  process  is  repeated  until  all  vertices  are  deleted  or  until  the  user 
has  finished. 


5.2  DELETE  EDGE 


ENTER  LINE  NUMBERS. 

HIT  <RETURN>  OR  ENTER  QUIT'  WHEN  DONE 
LINE  NUMBER(S): 

One  edge  (n)  or  a group  of  edges  (n-m)  may  be  deleted.  These  specifications 
are  entered  in  the  same  format  as  the  DELETE  VERTEX,  The  user  is  prompted  for 
LINE  NUMBER(S):  until  the  EDGE  array  is  empty  or  the  user  is  done. 
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5.3  DELETE  POLYGON 


ENTER  LINE  NUMBERS. 

HIT  <RETURN>  OR  ENTER  ’QUIT’  WHEN  DONE 
LINE  NUMBER(S): 

One  polygon  (n)  or  a group  of  polygons  (n-m)  may  be  deleted.  These 
specifications  are  entered  in  the  same  format  as  the  DELETE  VERTEX.  The  user 
is  prompted  for  LINE  NUMBERS:  until  the  POLY  array  is  empty  or  the  user  is 

finished. 

6.  DEVICE 

At  the  begining  of  program  execution,  the  output  device  for  graphics  display 
defaults  to  the  Lexidata.  DEVICE  is  used  to  select  a new  default  device.  The 
possible  selections  are 

ICALCOMP 

PRINTER  I (default  = LEXIDATA) 

LEXIDATA  j 
CONSOLE  1 

7.  DISPLAY 

Array  elements  are  displayed  in  graphics  mode. 

7.1  DISPLAY  VERTEX 

Each  vertex  in  the  model  is  displayed  and  labelled  with  its  vertex  number. 

7.2  DISPLAY  EDGE 


The  model’s  edges  are  displayed. 


7.3  DISPLAY  POLYGON 


The  model’s  polygons  are  displayed. 


7.4  DISPLAY  [ALL] 

All  the  edges  and  polygons  in  the  model  are  displayed. 

8.  DUPLICATE 

Elements  are  duplicated  at  other  locations.  The  new  elements  are  added  to  the 
array. 
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8.1  DUPLICATE  EDGE 


WHICH  EDGE(S)? 

The  specifications  for  duplicating  edges  are  entered  in  one  of  several  ways: 

n 

n-m 

n- 

n BY  X,Y,Z 
n-m  BY  X,Y,Z 
n-  BY  X,Y,Z 

where  n and  m are  positive  integers  and  X,Y,Z  are  real  numbers.  One  edge  (n) 
or  a group  of  edges  (n-m)  may  be  duplicated.  n-  represents  all  the  edges  from 
n through  the  last  element  in  the  EDGE  array.  The  displacement  vector  is 
specified  by  X,Y,Z.  If  this  vector  is  not  specified,  the  user  is  prompted  for 
it.  Edges  can  be  duplicated  until  <RETURN>  is  pressed  or  QUIT  is  entered. 

8.2  DUPLICATE  POLYGON 


WHICH  POLYGON(S)? 

One  polygon  (n)  or  a group  of  polygons  (n-m)  may  be  duplicated.  The 
specifications  are  entered  in  the  same  format  as  for  DUPLICATE  EDGE.  The 
process  of  duplicating  polygons  can  be  terminated  by  hitting  <RETURN>  or 
entering  QUIT. 

Note:  In  DUPLICATE,  the  displacment  vector  can  be  entered  using  a type  of 

shorthand.  A zero  may  be  represented  by  a blank  or  by  no  character  at  all. 


e.g. 


long  form 
10,8,0 
0,7,0 
0,0,6 
1,0,3 


short  form 

10,8 

,7 
, ,6 
1,,3 


9.  END 


The  graphics  display  screen  is  erased.  Execution  of  BUILD  is  terminated. 

10.  ERASE 


The  graphics  display  screen  is 
CALCOMP. 


erased. 

11. 


Note: 

EXIT 


this  command  is  ignored  for  the 


The  command  source  is  changed  to  the  console. 
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12 


FIELD 


The  field  of  view  is  altered  by  moving  the  observer  and  changing  the  angle  of 
view. 

CURRENT  DISTANCE  TO  ORGIN:  x.  xx 

NEW  DISTANCE  TO  ORIGIN? 

A positive  real  number,  X,  is  entered.  The  observer  is  positioned  at  the 
point  (0,-X);  i.e.  X units  in  front  of  the  viewing  surface. 

CURRENT  ANGLE  OF  VIEW;  x.  xx 
NEW  ANGLE  OF  VIEW? 

The  angle  is  measured  in  degrees.  A positive  real  number  in  entered. 

13.  GET 

A structure  file  is  opened.  Elements  are  read  into  variables  and  arrays. 

This  file  becomes  the  new  INFILE. 


GET  FILENAME 

The  specified  file  is  opened  and  read. 


GET 

The  INFILE  is  opened  and  read.  If  there  is  no  INFILE,  the  user  is  prompted 
for  a filename. 

14.  HELP 

The  BUILD  commands  and  their  functions  are  listed  at  the  console.  Only  a 
portion  of  the  list  appears  followed  by 

CONTINUE?  Y/N 

Either  the  letter  Y (for  yes)  or  the  letter  N (for  no)  is  entered.  The 
remaining  commands  are  listed  if  Y is  entered.  Nothing  else  is  listed  if  N i 
entered. 

15.  INPUT 

The  command  source  is  changed  to  a specified  file.  Possible  formats  are 

INPUT  filename 
or 

INPUT 

The  user  is  prompted  for  a filename  in  the  latter  case. 

16.  LIST 

The  array  elements  and/or  the  transformation  matrix  are  Listed  at  tlie  console 
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16.1  LIST  VERTEX 


The  world  and  window  coordinates  are  listed.  The  user  is  prompted  for  the 
vertices  to  list: 

WHICH  VERTICES? 

There  are  three  formats  for  entering  vertices: 
n 

n-m 

n- 


where  n and  m are  positive  integers.  One  vertex  (n)  or  a group  of  vertices 
(n-m)  may  be  listed.  n-  represents  all  the  vertices  from  n through  the  last 
element  in  the  VERTEX  array.  The  user  is  prompted  for  more  vertices  with 

WHICH  VERTICES? 

This  process  is  repeated  until  the  user  hits  <RETURN>  or  types  QUIT. 

16.2  LIST  EDGE 

Only  the  model's  edges  are  listed. 

WHICH  ELEMENTS? 

One  edge  (n)  or  a group  of  edges  (n-m)  may  be  listed.  These  specifications 
are  entered  in  the  same  format  as  in  LIST  VERTEX.  The  user  is  prompted  for 
edges  until  <RETURN>  is  pressed  or  QUIT  is  entered. 

16.3  LIST  POLYGON 
The  model's  polygons  are  listed. 

WHICH  ELEMENTS? 

One  polygon  (n)  or  a group  of  polygons  (n-m)  may  be  listed.  These 
specifications  are  entered  in  the  same  format  as  in  LIST  VERTEX.  The  user  is 
prompted  for  polygons  until  <RETURN>  is  pressed  or  QUIT  is  entered. 

16.4  LIST  MATRIX 

The  transformation  matrix  is  listed. 

17.  MOVE 

Elements  are  moved  to  new  locations. 
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17.1  MOVE  VERTEX 


VERTEX  n = 

There  are  several  possible  formats  for  response: 
n 

n-m 

n- 

n TO  X,Y,Z 
n BY  X,Y,Z 
n-  BY  X,Y,Z 

One  vertex  (n)  or  a group  of  vertices  (n-m)  may  be  moved.  Note:  n- 

represents  all  the  vertices  from  n through  the  last  element  in  the  VERTEX 
array.  n and  m are  entered  as  positive  integers.  Vertices  may  be  moved  by  a 
distance  relative  to  the  origin;  the  displacement  vector  is  given  by  (X,Y,Z). 
In  addition,  a single  vertex  can  be  moved  to  a specific  point  (X,Y,Z).  In 
both  cases,  X,Y,Z  are  entered  as  real  numbers.  If  the  input  consists  of  only 
the  vertex  number(s),  the  user  will  be  prompted  for  a relative  displacement 
vector.  This  process  of  moving  vertices  will  continue  until  <RETURN>  is 
pressed  or  QUIT  is  entered. 


17.2  MOVE  EDGE 


MOVE  EDGE(S) 

The  specifications  for  moving  the  edges  are  entered  in  one  of  several  ways: 
n 

n-m 

n- 

n BY  X,Y,Z 
n-m  BY  X,Y,Z 
n-  BY  X,Y,Z 

where  n and  m are  positive  integers  and  X,Y,Z  are  real  numbers.  One  edge  (n) 
or  a group  of  edges  (n-m)  may  be  moved.  n-  represents  all  the  edges  from  n 
through  the  last  element  in  the  EDGE  array.  The  displacement  vector  is  speci- 
fied by  X,Y,Z.  If  this  vector  is  not  specified,  the  user  is  prompted  for 
it.  Edges  can  be  moved  until  <RETURN>  is  pressed  or  QUIT  is  entered. 

17.3  MOVE  POLYGON 


MOVE  POLYGON(S) 

One  polygon  (n)  or  a group  of  polygons  (n-ra)  may  be  moved.  The  specifications 
are  entered  in  the  same  format  as  for  MOVE  EDGE.  The  process  of  moving  poly- 
gons can  be  terminated  by  hitting  <RETURN>  or  entering  QUIT. 

Note:  In  MOVE,  the  displacement  vector  can  be  entered  using  a type  of  short- 
hand. A zero  may  be  represented  by  a blank  character  or  by  no  character  at 
all. 
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e. g.  long  form 

10,8,0 
0,7,0 
0,0,6 
1,0,3 


The  array  elements  and/or 


short  form 

10,8 

,7 
, ,6 
1,,3 

18.  PRINT 


the  transformation  matrix 


18.1  PRINT  VERTEX 


are  listed  at  the  printer. 


The  world  and  window  coordinates  are  printed.  Then  all  the  vertices  are 
listed. 


18. 2 PRINT  EDGE 

All  of  the  model's  edges  are  listed. 

18. 3 PRINT  POLYGON 

All  of  the  polygons  are  printed. 

18.4  PRINT  MATRIX 

The  transformation  matrix  is  printed. 

18.5  PRINT  ALL 

The  world  and  window  coordinates  are  printed.  All  of  the  vertices,  edges,  and 
polygons  are  listed.  The  transformation  matrix  is  printed. 


19.  ROTATE 

The  model  is  rotated  about  a specified  point.  Rotations  take  place  about 
X',Y',Z'  axes.  These  axes  passing  through  the  given  point,  are  parallel  to 
the  X,Y,Z  axes,  respectively,  of  the  coordinate  system. 

ANGLES?  (X,Y,Z) 

Three  real  numbers,  separated  by  commas,  are  entered.  These  numbers  specify 
the  angles  (in  degrees)  of  rotation  about  the  X',  Y',  Z’  axes,  respectively. 
Note  that  the  rotations  will  be  made  in  the  X',  Y',  Z'  order. 

RELATIVE  ORIGIN?  (X,Y,Z) 

The  point  about  which  rotations  occur  is  specified.  The  center  of  the  model 
is  chosen  by  hitting  the  <RETURN>  key.  A different  point  is  chosen  by  enter- 
ing the  appropriate  X,Y,Z  coordinates.  These  coordinates  are  entered  as  three 
real  numbers  separated  by  commas. 

After  both  prompts,  the  response  can  be  entered  using  a type  of  short- 
A zero  may  be  represented  by  a blank  character  or  by  no  character  at 


Note: 

hand. 

all. 
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e.g 


long  form 


short  form 


10,8,0 

0,7,0 

0,0,6 

1,0,3 


10,8 


20.  SAVE 


Variables  and  array  elements  are  written  to  a file.  This  structure  file  is 
closed  and  becomes  the  new  OUTFILE. 

SAVE  filename 

The  current  work  file  is  saved  in  the  specified  file. 


The  work  file  is  saved  in  the  OUTFILE.  If  there  is  no  OUTFILE,  the  user  is 
prompted  for  a filename. 

21.  SCALE 

All  the  vertices  are  scaled  about  the  center  point  of  the  structure. 

SCALE  FACTOR? 

A positive  real  number  is  entered.  If  the  number  is  greater  than  one,  the 
model  is  magnified.  The  model  is  reduced  if  the  number  is  less  than  one. 


The  defaults  for  line  width,  color,  and  polygon  filling  are  chosen. 

LINE  WIDTH  (0-15) 

An  integer  is  entered.  As  the  numbers  increase,  the  lines  become  wider.  At 
the  start  of  program  execution,  the  default  value  is  2. 

COLOR  (1-15) 

An  integer,  corresponding  to  the  desired  color,  is  entered.  Initially,  the 
default  value  is  1. 

FILL  TYPE  (0-4) 

An  integer,  indicating  a particular  polygon  filling,  is  entered.  At  the 
start,  the  default  value  is  0.  (See  FILTYP  in  Appendix  A). 


SAVE 


22.  SELECT 


Note:  If  the  default  value  for  an  attribute  is  not  to  be  changed,  the 

<RETURN>  key  is  pressed  after  the  prompt. 


23.  SET 


At  the  beginning  of  program  execution,  the  input  device  for  data  (vertices, 
edges,  and  polygons)  defaults  to  the  keyboard.  SET  is  used  to  select  a new 
default  input  device.  The  possible  selections  are 

( KEYBOARD \ 

SET  (JOYSTICK)  (default  = KEYBOARD) 

( TABLET  j 

24.  SQUEEZE 

Vertices  which  were  deleted  with  the  DELETE  command  and  vertices  which  are  not 
used  in  any  polygon  or  edge  are  removed  from  the  VERTEX  array.  The  remaining 
vertices  are  shifted  up  in  the  array  in  order  to  fill  empty  slots.  The  EDGE 
and  POLY  arrays  are  adjusted  to  account  for  the  new  vertex  numbers. 

25.  STATUS 

Some  general  information  concerning  the  work  file  appears  at  the  console.  The 
filenames  of  the  INFILE  and  OUTFILE  are  listed.  The  number  of  elements  in  the 
VERTEX,  EDGE,  and  POLY  arrays  are  indicated  along  with  the  size  of  each  array. 

26.  TRANSLATE 

The  vertices  of  the  model  are  translated. 

TRANSLATE  VERTICES  BY  (DX,DY,DZ) 

Three  real  numbers,  separated  by  commas,  are  entered.  These  numbers  indicate 
the  total  displacement  of  the  model  in  the  X,Y,Z  directions.  The  numbers  can 
be  entered  using  a type  of  shorthand.  A zero  may  be  represented  by  a blank 
character  or  by  no  character  at  all. 


e.g.  long  form  short  form 

10,8,0  10,8 

0,7,0  ,7 

0,0,6  ,,6 

1,0,3  1,,3 


27.  WINDOW 

The  boundaries  of  the  window  are  specified. 

ENTER  THE  LOWER  LEFT  VERTEX; 

If  the  input  device  is  the  joystick  or  the  tablet,  the  picking  implement  is 
used  to  point  to  the  lower  left  corner  of  the  window  and  then  button  1 is 
pressed.  If  the  keyboard  is  the  input  device,  then  the  user  in  prompted 


X,Y,Z,IDV= 
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Three  real  numbers,  followed  by  the  number  1,  are  entered.  These  numbers  are 
separated  by  commas  or  spaces.  The  real  numbers  specify  the  X,Y,Z,  coordi- 
nates, respectively,  of  the  lower  left  corner  of  the  window.  Note:  The  Z- 

coordinate  is  assigned  the  value  zero,  regardless  of  the  value  entered  by  the 
user. 

ENTER  THE  UPPER  RIGHT  VERTEX: 

This  vertex  is  entered  in  the  same  manner  as  the  lower  left  vertex. 

28.  WORLD 

The  boundaries  of  the  world  space  are  specified. 

ENTER  THE  LOWER  LEFT  FRONT  VERTEX: 

If  the  input  device  is  the  joystick  or  the  tablet,  the  picking  implement  is 
used  to  point  to  the  lower  left  front  corner  of  the  box  which  will  be  the 
world  space.  Button  1 is  then  pressed.  If  the  keyboard  is  the  input  device, 
then  the  user  is  prompted 


X,Y,Z,IDV= 


Three  real  numbers,  followed  by  the  number  1,  are  entered.  These  numbers  are 
separated  by  commas  or  spaces.  The  real  numbers  specify  the  X,Y,Z  coordi- 
nates, respectively,  of  the  lower  left  front  corner  of  the  box. 

ENTER  THE  UPPER  RIGHT  BACK  VERTEX: 

This  vertex  is  entered  in  the  same  manner  as  the  lower  left  front  vertex. 
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APPENDIX  E 


The  following  is  a description  of  each  TITLES  command.  The  prompts 
corresponding  to  each  command,  together  with  the  formats  of  the  user's 
responses,  are  indicated. 

1.  ADD 

Character  strings  are  added  to  a specified  slide. 


FRAME= 


An  integer  is  entered  to  specify  a slide 
COLOR= 

An  integer  (1-15)  is  entered  to  specify  a default  color  for  the  new  character 
strings. 


SET= 


An  integer  (1-24)  is  entered  to  specify  a default  character  set  for  the  new 
text. 

INPUT  THE  STRING 

The  character  string  is  entered.  The  character  sets  and  colors  used  within 
the  string  are  modified  with  control  sequences.  In  addition,  control 
sequences  are  used  to  place  subscripts  and  superscripts  in  the  string  and  to 
change  the  justification  of  the  text.  See  Appendix  B for  a list  of  these 
sequences. 

TOGGLE  BUTTON  FOR  LOWER  LEFT 

The  cursor  is  moved  to  select  the  location  of  the  lower  left  corner  of  the 
string.  Once  the  cursor  is  set  in  place,  the  text  is  displayed. 

DEL(l),  M0V(2),  CENTER(3),  SCALE(4)= 

An  integer  (1-4)  is  entered: 

1 - The  string  is  deleted. 

2 - The  text  will  be  moved.  TOGGLE  BUTTON  TO  MOVE  LL  CORNER.  The  cursor 

is  positioned  at  the  desired  location  of  the  lower  left  corner  of  the 
text.  Once  the  cursor  is  set  in  place,  the  text  is  moved. 

3 - The  string  is  centered  on  the  line. 

4 - The  text  is  scaled  by  a SCALE  FACTOR  which  is  specified  as  a positive 

real  number. 

<RETURN>  - The  string  is  not  modified. 
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Only  one  correction  can  be  made  at  a time.  The  prompt  for  corrections  will 
reappear  until  the  string  is  deleted  or  the  <RETURN>  key  is  entered. 

INPUT  THE  STRING 

Another  string  may  be  added  to  the  slide.  When  no  other  strings  are  to  be 
added,  the  <RETURN>  key  is  entered. 


2.  BULLET 

A bullet  is  drawn  on  a specified  slide. 


FRAME= 


An  integer  is  entered  to  specify  the  slide  on  which  the  bullet  will  be  drawn. 
COLOR= 

An  integer  (1-15)  is  entered  to  select  the  color  of  the  bullet. 

TOGGLE  FOR  CENTER 

The  cursor  is  positioned  at  the  desired  location  of  the  bullet.  Once  the 
cursor  is  set,  the  bullet  is  displayed. 


3.  CIRCLE 

A circle  is  drawn  on  a specified  slide. 


FRAME= 

An  integer  is  entered  to  specify  the  slide  on  which  the  circle  will  be  drawn. 
COLOR= 

An  integer  (1-15)  is  entered  to  select  the  color  of  the  bullet. 

TOGGLE  FOR  CENTER 

The  cursor  is  positioned  at  the  location  of  the  circle's  center. 

TOGGLE  FOR  RADIUS 

The  cursor  is  positioned  at  the  location  of  any  point  on  the  circle.  Once  the 
cursor  is  set,  the  circle  is  drawn. 


4.  COLORS 


All  of  the  available  colors  are  displayed. 


5.  CORRECT 


The  Cext  on  a slide  is  corrected  one  string  at  a time. 


FRAME= 


An  integer  is  entered  to  specifiy  the  slide  which  will  be  corrected.  A line 
of  text  is  printed  at  the  console,  followed  by 

DEL(l),  M0V(2),  CENTERO),  SCALE(4)  = 

An  integer  (1-4)  is  entered: 

1 - The  string  is  deleted. 

2 - The  text  will  be  moved.  TOGGLE  BUTTON  TO  MOVE  LL  CORNER.  The  cursor 

is  positioned  at  the  desired  location  of  the  lower  left  corner  of  the 
text.  Once  the  cursor  is  set  in  place,  the  text  is  moved. 

3 - The  string  is  centered  on  the  line. 

4 - The  text  is  scaled  by  a SCALE  FACTOR  which  is  specified  as  a positive 

real  number. 

<RETURN>  - The  string  is  not  modified 

Only  one  correction  can  be  made  at  a time.  This  prompt  for  corrections  will 
reappear  until  the  string  is  deleted  or  the  <RETURN>  key  is  entered. 

The  next  line  of  text,  along  with  the  prompt  for  corrections,  is  displayed  on 
the  console.  This  process  is  repeated  for  each  line  of  the  text  on  the  slide. 


6.  DELAY 

The  delay  time  for  the  hard  copy  device  is  specified.  An  integer  is  entered 
for  this  delay  time. 

7.  END 

The  program  is  terminated. 


8.  HELP 


The  TITLES  commands  are  listed. 


9.  NEW 

A new  slide  is  created.  The  frame  number  is  incremented.  New  character 
strings  are  added  to  this  slide  as  with  the  ADD  command. 

10.  LINE 

A line  is  drawn  on  a specified  slide. 


FRAME= 


An  integer  is  entered  to  specify  the  slide  on  which  the  line  will  be  drawn. 
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COLOR= 


An  integer  (1-15)  is  entered  to  select  the  color  of  the  line. 

TOGGLE  FOR  START  OF  LINE 

The  cursor  is  positioned  at  the  location  of  one  of  the  line's  endpoints. 

TOGGLE  FOR  END  OF  LINE 

The  cursor  is  positioned  at  the  location  of  the  other  endpoint  of  the  line. 
Once  the  cursor  is  set,  the  line  is  drawn. 

11.  PROCESS 

Hard  copies  of  specified  slides  are  generated. 

INPUT  SLIDE  //  (0  TO  PROCESS.  ) AND  FRAME  COUNT  = 

Two  integers  are  entered  to  indicate  the  slide  number  and  the  number  of  hard 
copies,  respectively. 

INPUT  SLIDE#  (0  TO  PROCESS,)  AND  FRAME  C0UNT= 

Another  slide  may  be  specified  for  copying.  When  all  the  desired  slides  have 
been  specified,  a zero  is  entered.  The  hard  copies  are  then  processed  and  the 
program  is  terminated. 

12.  REREAD 

A file  is  opened  and  data  is  read  into  variables. 

RESTART  FILE 

The  name  of  a data  file  is  entered.  A new  file  may  be  started  by  just  hitting 

<RETURN>. 

n SLIDES 
FUNCTI0N= 

The  user  is  informed  of  the  number  of  slides  in  the  the  data  file.  A corairuand 
is  then  specified  by  the  user. 


13.  SAVE 

The  slides  in  the  work  file  are  written  to  a data  file.  If  a data  file  has 
been  opened,  the  slides  are  written  to  this  file.  Otherwise,  tlie  user  Is 
prompted  for 
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FILE  NAME 


The  name  of  the  new  data  file  is  entered. 

14.  SET 


A character  set  is  displayed. 

SET  N0.= 

A integer  (1-24)  is  entered  to  select  a character  set. 

15.  VIEW 


A slide  is  displayed. 

NUMBER= 

An  integer  is  entered.  This  number  indicates  the  slide  to  be  displayed.  Once 
the  image  has  been  generated,  the  process  is  repeated  with  the  NUMBER=  prompt. 
When  no  other  slides  are  to  be  displayed,  a zero  or  the  <RETURN>  key  is 
entered. 
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PROGRAM  G2TEST 
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PROGRAM  G2TEST 


INTEGER  PB(6) 

C 

C TEST  EACH  FUNCTION  OF  THE  DEVICE  INDEPENDENT  PCKAGE 
C 


C 


c 

c 

c 


WRITE(5,1) 
WRITE(5, 1) 
WRITE(5, 1) 
WRITE(5, 1) 
WRITE(5, 1) 
WRITE(5,1) 
WRITE(5,1) 
WRITE(5, 1) 
WRITE(5, 1) 
WRITE(5, 1) 
WRITE(5, 1) 
WRITE(5, 1) 
WRITE(5, 1) 
WRITE(5, 1) 


I I 

'ANGLE  r 
'CIRCLE  2' 

'FLYING  CUBE  3' 

'GRAFIT(i)  4' 

'GRAFIT(2)  5' 

'GRAFIT(3)  6' 

'GRAFIT(4)  7' 

'PHASE  SPACE  PLOT  (CONTOUR  AND  SURFACE  PLOT) 
'SINGLE  ROOM  FIRE  9' 

'SADDLE  SURFACE  iO' 

'HARDWARE/ HERS HEY  SYMBOLS  II' 

'3D  CONTOURING  12' 

'POLYGON  FILLING  13' 


CALL  SYSIO(PB,41,5, ' TEST  =',7,0) 
READ(5,3,END=4,ERR=4)  I 


GET  THE  DEVICE 

CALL  SYSIO(PB,33,5, 'DEVICE=' ,7,0) 

READ(5,2)  ID 
2 FORMAT(I) 

CALL  DEVICE(ID) 

GO  TO  (201,202,203,204,205,206,207,208,209,210,211,212, 

213), I 

STOP  'NO  SELECTION' 


201 

CALL 

ANGTST 

202 

CALL 

CIRC(ID) 

203 

CALL 

CUBE 

204 

CALL 

GRAFITl(ID) 

205 

CALL 

GRAFIT2(ID) 

206 

CALL 

GRAFIT3(ID) 

207 

CALL 

GRAFIT4(ID) 

208 

CALL 

PHASE 

209 

CALL 

RUMTST 

210 

CALL 

SADDLE(ID) 

211 

CALL 

SYMTST 

212 

CALL 

VOLTST(ID) 

213 

CALL 

FILNGT(ID) 

1 

FORMAT ( IX, A50) 

3 

FORMAT(I) 

4 

STOP 

END 

C 


8’ 
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51 
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61 
62 
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78 
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83 

84 

85  C 

86  C 

87  G 

88 
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SUBROUTINE  ANGTST 

A SLMPLE  TEST  OF  THE  CHARACTER  STUFF 

CHARACTER*!  TITLE(80) 

INTEGER  PB(6) 

CHARACTER*80  STRING 

FIRST  A SIMPLE  DEMONSTRATION 

CALL  GRISET  (0. ,0.  , 100. , 100. ) 

CALL  NEWFRM 

CALL  WDDRAW  (50.  ,90.  ,6.  ,0. ,8.  ,0.  ,8. , ' 1LL1C02EFT1 . ’ ) 

CALL  WDDRAW  (50.  ,75. ,6.  ,0.  ,8.  ,0.  ,8. , ’ 1M1C01C1C02ENTERED1 . ’ ) 
CALL  WDDRAW  ( 50.  , 60. , 6. , 0. , 8. , 0.  , 8.  , ' 1R1C0 1R1C02IGHT1 . ’ ) 
STRING=’1M1C0111C0221C0331C0441C0551C0661C0771C0881C1391G1401. 

f 

• 

CALL  WDDRAW  (50. ,45. ,6. ,0.  ,8.  ,0. ,8. , STRING) 

STRING=’1M1C01ALS01U1C05SUP£RSCRIPTS10  ICO  1AND1C051DSUBSCRIPTS 

• 1.  ' 

CALL  WDDRAW  (50. ,30. ,6. ,0. ,4. ,0. ,5. .STRING) 

STRING  = '1MABC1U1. 2341.  ' 

CALL  LABEL( STRING, 60. ,10.  ,90.  ,20. , . 50) 

STRING='1M1C011H04AND  1C03YOU  1C071H18CAN  1H04CHANGE  CHARACTER 
. 1C031H18SETS1. ’ 

CALL  WDDRAW  (50. ,20. ,6.  ,0. ,4.  ,0.  ,5. .STRING) 

STRING  = '1C021H04S1US1USVUS1.  ' 

CALL  WDDRAW  ( 10. , 10. ,6. ,0. ,4. ,0. , 5. , STRING) 

STRING  = '1C0310D1DD1DD1DD1. ’ 

CALL  WDDRAW (20. , 10.,  6.,  0.,  4.,  0.,  5.,  STRING) 

STRING  = '1G08NOW  TRY  ONE  YOURSELF !1.' 

CALL  WDDRAW( 10. ,1. ,6. ,0. ,4. ,0. ,5. .STRING) 

CALL  FRAME 
PAUSE 

THE  RESTART  POSITION  - SCART  WITH  THE  ANGLE  OF  THE  TEXT 

4 CALL  SYSIO(PB, 33,5, 'ANGLE=' ,6,0) 

R£AD(5,1)  ANGLE 
1 FORMAT(2F) 

IF(ANGLE.LT.O.O)  GO  TO  5 
THETA  = ANGLE/ 5 7. 295 
DO  7 I = 1,  80 
7 TITLE(I)  = ' ' 

ERASE  THE  SCREEN  AND  PREPARE  TO  DRAW 

CALL  NEWFRM 

CALL  SYSIO(PB,33,5, ’TEXT=',5,0) 

READ(5,3)  TITLE 
3 FORMAT (80A1) 

DO  11  I = 1,  80 
II  = 81  - I 

IF(TITLE( II).NE. ’ ')  GO  TO  12 
11  CONTINUE 
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L06 

GO  TO  4 

107 

12 

TITLE(II+1)  = 'V 

108 

TLTLE(II+2)  = ' 

109 

C 

CALL  SYSIO(PB,33,5, ' LINWID= ' , 7 , 0) 

1 10 

C 

READ(5,2)  LW 

1 11 

CALL  DEFINE  (0. , 0. , 13. , 13. ) 

1 12 

CALL  COLOR(4) 

113 

c 

CALL  LINWID(LW) 

1 14 

CALL  BOXPLT  (0.5,  0.5,  12.5,  12.5) 

1 15 

CALL  COLOR(5) 

1 16 

CALL  WDCOUNT(TITLE,NT) 

117 

IF(NT.EQ.O)  GO  TO  4 

1 18 

c 

1 19 

c 

DRAW  THE  LABEL 

120 

c 

121 

YB  = 5.0 

122 

XPOS  = 5.0 

123 

XRIGHT  = XPOS  + MIN(FLOAT(NT) , 11. ) 

124 

YTOP  = YB  +1. 

125 

CALL  LABEL(TITLE,  XPOS,  YB , XRIGHT, 

126 

CALL  FRAME 

127 

GO  TO  4 

128 

c 

129 

c 

CLOSE  THE  PLOTTING  DEVICE  AND  ERASE  NON- 

130 

c 

131 

5 

CALL  ENDFRM 

132 

STOP 

133 

END 
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135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 
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SUBROUTINE  CIRC(ID) 

CALL  NEWFRM 
IF(ID,NE.  1)  THEN 

CALL  DEFINE  (0. ,0.  , 10.  , 10.  ) 

ELSE 

CALL  SCALNG  (0. ,0. , 10. , 10. ,0. ,0. , 7 . 9 , 7 . 9 , 0. ,0. ,0. , 0. ) 
ENDIF 

CALL  COLOR(2) 

CALL  LINWID(4) 

CALL  FILTYP(l) 

CALL  CIRCLE(5. ,5. ,4. ) 

CALL  FRAME 
PAUSE 

CALL  ERASE 
CALL  ENDFRM 
STOP 
END 
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SUBROUTINE  00*3 


151 

SUBROUTINE  CUBE 

152 

COMMON  QN0RM(3,6),VERT(3,8),IEDGV1(12),IEDGV2(12), 

153 

. 

ISURF(6) ,IPEDG(24) ,NVERT,NEDGS,NSURf,F,SCAL£(4) 

15A 

INTEGER  IV(2)/2,0/ 

155 

C 

156 

DLMENSION  T( 4 , 4)  , QM(  4 , 4)  , QMT(4 , 4) 

1 57 

DX  = 4. 

158 

DY  = 4. 

1 59 

XL  = -1.  5 - 0.  1*4. 

1 60 

XR  = +3.  + . 15*4. 

161 

XB  = -1. 5 - 0.  1*4. 

162 

XT  = +3.  + 0.  15*4. 

163 

CALL  DEFINE  (XL,  XB , XR,  XT) 

164 

CALL  DELAY(26) 

165 

CALL  NEWFRM 

1 66 

CALL  C0L0R(5) 

167 

CALL  LINWID(3) 

168 

NVERT  = 8 

169 

NEDGS  = 12 

170 

NSURF  = 6 

171 

F = 3. 

172 

XINCR  = .5  / 95. 

173 

DO  100  I = 1,  4 

174 

DO  100  J = 1,  4 

175 

T(I,J)  = 0.0 

176 

IF(I.EQ.J)  T(I,I)  = 1.0 

177 

100 

CONTINUE 

178 

XC  = 0.5 

179 

YC  = 0. 5 

180 

ZC  = 0.5 

181 

CALL  SETMAT  (QM , 1 , 1 . 0 , 0 , 0 , 0) 

132 

DO  1000  I = 1,  95 

183 

CALL  TRANS (T) 

184 

XCl  = XC  - XINCR 

185 

YCl  = YC  - XINCR 

186 

ZCl  = ZC  - XINCR 

187 

Q4(l,4)  = -(QM(1,1)*XC  + QM(1,2)*YC)  + XCl 

188 

QM(2,4)  = -(QM(2,1)*XC  + QM(2,2)*YC)  + YCl 

189 

QM(3,4)  = -ZC  + ZCl 

190 

XC  = XCl 

191 

YC  = YCl 

192 

ZC  = ZCl 

193 

CALL  MM  (T,QM,T) 

194 

1000 

CONTINUE 

195 

CALL  TRANS (T) 

196 

CALL  SETMAT(QM,2, 1.0,0,0,0) 

197 

DO  2000  1=1,  192 

198 

F = F + . 15 

199 

2000 

CALL  TRANS (T) 

200 

CALL  SETMAT(QM,3, 1.0,0,0,0) 

201 

DO  3000  1=1,  192 

202 

F = F - .15 

203 

CALL  MM(T,QM,T) 

204 

3000 

CALL  TRANS (T) 

205 

CALL  SETMAT(QM, 1, 1.0, 0,0,0) 
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206 

207 

208 

209 

210 

2ii 

212 

213 

214 

215 

2ib 

217 

218 

219 

220 

221 

222 

223 

2 24 

225 

226 

227 

228 

2 29 

2 30 
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CALL  SETMAT(QMT,2, 1.0,0,0,0) 

CALL  MM(QM,QMT,QM) 

DO  4000  1=1,  96 
CALL  MM(T,QM,T) 

CALL  TRANS(T) 

CALL  SETMAT(QMT,3, 1.0,0,0,0) 

CALL  MM  (QM,QMT,QM) 

THETA  = 3. 14159265/180. 

ANGLE8  = 3.141592  + THETA 
DO  5000  1=1,  360 
XCl  = SIN(ANGLE8) 

ZCl  = C0S(ANGLE8)+  1.0 
YCl  = FL0AT(I)/360. 

QM(1,4)  = -(QM(1,1)*XC  + QM(1,2)*YC  + QM(1,3)^ZC)  + XCl 

QM(2,4)  = -(QM(2,1)*XC  + QM(2,2)*YC  + QM(2,3)*ZC)  + YCi 

QM(3,4)  = -(QM(3,1)*XC  + QM(3,2)*YC  + QM(3,3)*ZC)  + ZCl 

XC  = XCl 
YC  = YCl 
ZC  = ZCl 

ANGLE8  = ANGLE8  + THETA 
CALL  MM  (T,QM,T) 

CALL  TRANS (T) 

CALL  ENDFRM 

STOP 

END 
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SUBROUTINE  MM(A,B,C) 

DIMENSION  A(4,4) ,B(4,4) ,C(4,4) ,D(4,4) 
DO  10  1=1,4 

DO  9 J = I,  4 
D(I,J)  = 0.0 
DO  8 K.  = 1,  4 

D(I,J)  = D(I,J)  + B(I,K)  * C(K,J) 

CONTINUE 

CONTINUE 

DO  20  I = 1,  4 

DO  20  J = 1,  4 

A(I,J)  = D(I,J) 

RETURN 

END 
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SUBROUTINE  MM3(A,B,C,K) 

DIMENSION  B(4,4),A(3),C(3) ,D(3) 

DO  10  I = 1,  3 

IF(K.EQ. 1)  D(I)  = B(I,4) 

IF(R.NE.l)  D(I)  = 0.0 

DO  9 J = 1,  3 

D(I)  = D(I)  + B(I,J)*C(J) 

CONTINUE 

DO  20  I = 1,  3 

A(I)  = D(I) 

RETURN 

END 
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SUBROUTINE  SETMAT(A, ITYPE , THETA, XT , YT , ZT) 
DIMENSION  A(4,4) 

RAD  = 3.  141592  / 180. 

DO  10  I = 1,  4 
DO  10  J = 1,  4 
A(I,J)  = 0.0 
A(4,4)  = 1.0 
ANGLE  = THETA  * RAD 
CT  = COS (ANGLE) 

ST  = SIN (ANGLE) 

GO  TO  (100, 200, 300, 400), ITYPE 

A(i,  1)  = CT 

A(2,l)  = -ST 

A(l,2)  = ST 

A(2,2)  = CT 

A(3,3)  = 1.0 

RETURN 

A(l,l)  = 1.0 
A(2,2)  = CT 
A(3,2)  = ST 
A(2,3)  = - ST 
A(3,3)  = CT 
RETURN 
A(l,  1)  = CT 
A(3,l)  = -ST 
A(l,3)  = ST 
A(3,3)  = CT 
A(2,2)  = 1.0 
RETURN 

A(l,l)  = 1.0 
A(2,2)  = 1.0 
A(3,3)  = 1.0 
A(l,4)  = XT 
A(2,4)  = YT 
A(3,4)  = ZT 
RETURN 
END 
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294 

SUBROUTINE  TRANS(R) 

295 

COMMON  QNORM(3,6),VERT(3,8) ,IEDGV1(12),IEDGV2(12), 

296 

• 

ISURf(6) ,IPEDG(24) ,NVERT,NEDGS,NSURf ,F,SCAL£(4) 

297 

DIMENSION  R(4,4),RVERT(3,8) ,QN(4) 

298 

DLMENSION  IEDG(  1 2)  , XP(  1 2)  , YP(  1 2) 

299 

DO  10  I = 1,  NEDGS 

300 

10 

lEDG(I)  = 0 

301 

DO  20  I = 1,  NVERT 

302 

CALL  MM3 ( RVERT ( 1 , I ) , R , VERT ( 1 , I ) , 1 ) 

303 

20 

CONTINUE 

304 

IPTS  = 1 

305 

DO  100  I = 1,  NSURF 

306 

K = ISURF(I) 

307 

IPTF  = IPTS  + R - 1 

308 

CALL  MM3(QN,R,QNORM( 1,I),0) 

309 

K1  = IPEDG(IPTS) 

310 

K2  = lEDGVl(Kl) 

311 

XN2  = -RVERT(1,K2) 

312 

YN2  = -RVERT(2,K2) 

313 

ZN2  = -RVERT(3,K2)  - F 

314 

DOT  = QN(1)  * XN2  + QN(2)  * YN2  -i-  QN(3)  * ZN2 

315 

IF(DOT.LE.O.O)  GO  TO  100 

316 

DO  30  J = IPTS,  IPTF 

317 

JJ  = IPEDG(J) 

318 

30 

lEDG(JJ)  = lEDG(JJ)  + 1 

319 

100 

IPTS  = IPTF  + 1 

320 

DO  200  I = 1,  NVERT 

321 

ZPF  = RVERT(3,I)  + F 

322 

XP(I)  = F * RVERT(1,I)  / ZPF 

323 

YP(I)  = F * RVERT(2,I)  / ZPF 

324 

200 

CONTINUE 

325 

CALL  ERASE 

326 

DO  300  I = 1,  NEDGS 

327 

IF(IEDG(I).EQ.O)  GO  TO  300 

328 

11  = lEDGVl(I) 

329 

12  = IEDGV2(I) 

330 

CALL  LINE  (XP(Il),  YP(Il),  XP(I2),  YP(I2)) 

331 

300 

CONTINUE 

332 

CALL  FRAME 

333 

C 

CALL  UDCOPY 

334 

RETURN 

335 

END 
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BLOCKDATA  BLK 

COMMON  QNORM(3,6) ,VERT(3,8),IEDGVl(i2),lEDGV2(l2), 
ISURF( 6 ) , IPEDG( 24 ) , NVERT , NEDGS , NSURE , F , SCALE ( 4 ) 

DATA  QNORM/0,0,-1. , -1 . , 4*0 . , 2*1 . ,3*0. ,-l. ,0,0, 1. ,0/ 

DATA  VERT/ 4*0, 1 . , 0 , 2* 1 . , 0 , 1 . , 4*0 , 1 . , 0. , 6* 1 . , 0 , 1 . / 

DATA  lEDGV 1/1, 2, 3, 4, 5, 6, 7, 8, 1,2, 3,4/ 

DATA  IEDGV2/2, 3,4, 1,6,7,8, 5, 5,6,7,8/ 

DATA  ISURF/6*4/ 

DATA  IPEDG/1,2,3,4, 1,9,5,10,8,7,6,5,3,11,7,12,4,12,8,9, 
2, 10,6,11/ 

END 
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SUBROUTINE  GRAFITl(ID) 

DIMENSION  X(IOO),  Y(IOO) 

CHARACTER*31  YAXIS/ ' IGNITION  TIME  (MINUTES ) 1 . 

CALL  NEWFRM 
CALL  SETDEV(0,5) 

CALL  C0L0R(2) 

CALL  GRISET  (0.,  -50.,  1023.,  1023.) 

PIP  = 3.  1415 
PIM  = - PIP 
CALL  C0L0R(3) 

CALL  GRIlj^B(l,PIM,-2.  ,PIP,+2.  ) 

CALL  GRAFIT  (1,PIM,  PIP,  200.,  900.,  PIM,  PIP,  -2.0,  +2.0, 

100.,  800.,  -2.0,  +2.0,  'XAXIS1.',  3,  YAXIS,  5) 

CALL  COLOrU) 

CALL  GRIlAB(2,PIM,-2. ,PIP,+2. ) 

CALL  GRAFIT  (2, PIM,  PIP,  450.,  650.,  PIM,  PIP,  -2.0,  +2.0, 

200.,  500.,  -2.0,  +2.0,  'XAXISl.’,  3,  'YAXIS1.',  5) 

XOFF  = (PIP  - PIM)  / 100. 

DO  2 I = 1,  100 

XI  = PIM  + FLOAT(I-l)  * XOFF 

YI  = COS(XI) 

X(I)  = XI 
Y(I)  = YI 
CALL  COLOR(l) 

CALL  PLOTLN  (1,  X,  Y,  100) 

CALL  PLOTLN  (2,  X,  Y,  100) 

CALL  FRAME 
IFdD.EQ.  3)  PAUSE 
CALL  ENDFRM 
STOP 
END 


-117- 


SUBROUTINE  GRAflTZ 


page  13 


380 
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382  C 
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391 

392  . 
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432 
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434 


SUBROUTINE  GRAFIT2(ID) 

DIMENSION  X(100),Y(100) 

READ  IN  SOME  DATA  (X  VS  Y) 

LIN  = 3 

0PEN(UNIT=1,FIL£=’G1TEST2.DAT' ) 

CALL  RDCNL(Y,I1, IY,I2) 

CALL  RDCNL(X,Ii,IX,I2) 

IZ  = MIN0(IX,  lY) 

13  = IZ/3 

3 IREV  = 0 

DO  4 I = 1,  IZ-1 
II  = I + 1 

IF(X(I).LE,X(II))  GO  TO  4 
IREV  = IREV  -t-  1 
XP  = X(I) 

YP  = Y(I) 

X(I)  = X(II) 

Y(I)  = Y(II) 

X(II)  = XP 
Y(II)  = YP 

4 CONTINUE 

IF  (IREV.GT.O)  GO  TO  3 

SCALE  - WE  NOW  KNOW  HOW  BIG  TO  MAKE  THE  AXES 

XMAX  = 0.0 

XMIN  = 1. E+10 

YMAX  = 0.0 

YMIN  = l.E+10 

DO  1 I = 1,  IZ 

XMAX  = AMAX1(XMAX,X(I)) 

XMIN  = AMIN1(XMIN,X(I)) 

YMAX  = AMAX1(YMAX,Y(I)) 

1 YMIN  = AMIN1(YMIN,Y(I)) 

YMINC  = l.E+10 
YMAXC  =0.0 
DO  5 I = 1,  13 

YMINC  = AMIN1(YMINC,Y(I3-1+D) 

5 YMAXC  = AMAXl ( YMAXC, Y(I3-1+D) 

NOW  ROUND  OFF  THE  AXES  TO  APPROPRIATE  WHOLE  VALUES 
YMIN  = 0.0 

DELTAX  = (XMAX-XMIN)/9. 

DELTAY  = (YMAX-YMIN)/9. 


XMAXA  = 

XMAX 

- 

DELTAX 

* 

0.8 

XMINA  = 

XMIN 

+ 

DELTAX 

* 

1.5 

YMINA  = 

YMIN 

+ 

DELTAY 

•k 

1.5 

YMAXA  = 

YMAX 

- 

DELTAY 

k 

.8 

XMINB  = XMINA  + DELTAX 
XMAXB  = XMAXA  - 2.0*DELTAX 
YMINB  = YMINA  + DELTAY  * .76 
YMAXB  = YMAXA  - 2. 7*DELTAY 
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XMAX  = IFIX(XMAX+DELTAX/2. ) 

YMAX  = IFIX((YMAX+DELTAY)/100. )*100. 

CALL  NEWFRM 
CALL  LINWID(LIN) 

CALL  COLOR(l) 

CALL  GRISET  (XMIN,  YMIN,  XMAX,  YMAX) 

CALL  GR I LAB(  1 , XMIN, YMIN, XMAX,  YMAX) 

CALL  GRAFIT(  1 , XMIN  , XMAX,  XMINA  , XMAXA  , XMIN  , XMAX  , YMIN,  YMAIX, 
. YMINA,Y’MAXA,YMIN,  YMAII,  ' T LM£(MINUTES  ) 1 . ’ , 14 , 

. 'TEMPERATUR£(K)1. ' , 12) 

CALL  GRILAB(2,X(I3) , YMINC , X( 2*13) ,YMAXC) 

CALL  GRAFIT(2,X(I3) ,X(2*I3),XMINB,XMAXB,X(I3) ,X(2*I3), 

. YMINC,  YMAXC,YMINB,YMAXB,  YMINC,  YMAXC, 

. 'TLME(MINUTES)1.  ’ , 5,  'FLUE  TEMPERATURE(K)  1 , 5) 

CALL  COLOR(2) 

CALL  LINWID(4) 

CALL  PLOTLN(l,X,Y,I3) 

CALL  COLOR(3) 

CALL  PLOTLN(l ,X( 13-1) ,Y( 13-1) ,13) 

CALL  PLOTLN(2,X(I3) ,Y(I3),I3) 

CALL  COLOR(2) 

CALL  PL0TLN(1,X(2*(I3-1)),Y(2*(I3-1)),IZ-2*(I3-D) 

CALL  FRAME 
IF(ID.  EQ.3)  PAUSE 
CALL  ENDFRM 
STOP 
END 
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SUBROUTINE  RDCNL  (REED,  ICNL.MAXR  , lEOF) 


462 

463  C 

464  C 

465  C 

466  C 

467  C 

468  C 

469  C 

470  C 
47L  C 

472 

473 

474 

475 

476 

477 

478 

479 

480 

481  C 

482  C 

483  10 

484  20 

485  C 

486 


RRRRRRR 
RRRRRRRR 
RR  RR 

RR  RR 

RRRRRRR 
PR.  RR 
RR  RR 


END 


RRRRRRR 
RRRRRRRR 
RR  RR 

RR  RR 

RR  RR 

RRRRRRRR 
RRRRRRR 


RRRRRR 
RRRRRRRR 
RR  RR 

RR 

RR  RR 

RRRRRRRR 
RRRRRR 


RR  RR 

RRR  RR 
RRRR  RR 
RR  RR  RR 
RR  RRRR 
RR  RRR 
RR  RR 


RR 

RR 

RR 

RR 

RR 

RRRRRRRR 

RRRRRRRR 


DIMENSION  REED(IOO) 

READ  (1,10)  MAXR,IGNL,IEND 
IF  (lEND.  EQ.  999)  THEN 
IEOF=l 
ELSE 
IEOF=0 

READ  (1,20)  (REED(IR) ,IR=1,MAXR) 
END  IF 
RETURN 


FORMAT  (2I6,T78,I3) 
FORMAT  (7E11.5) 
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SUBROUTINE  GRAFIT3(ID) 

DIMENSION  X(IOO),  Y(IOO) 

CHARACTER*31  YAXIS/ 'TIME  SINCE  IGNIT ION1 . MINUTES) 1 .' / 
CHARACTER  IC/'Z’/ 

CALL  SETDEV(0,5) 

XMIN  = 0. 

XMAX  = 1000. 

YMIN  = 0. 

YMAX  = 1000. 

XMAXG  = 0.0 

YMAXG  = 0.0 

DO  3 J = 1,  5 

CALL  NEWFRM 

XMAXG  = XMAXG  + XMAX 

YMAXG  = YMAXG  + YMAX 

CALL  GRISET(XMIN,  YMIN, XMAXG, YMAXG) 

PIP  = 3.  1415 
PIM  = - PIP 
CALL  C0L0R(3) 

DX  = XMAX  - XMIN 

DY  = YMAX  - YMIN 

X200  = XMIN  + .2  * DX 

X900  = XMAX  - . 1 * DX 

YlOO  = YMIN  + .2  * DY 

Y800  = YMAX  - . 1 * DY 

CALL  GRILAB(l,PIM,-2. ,PIP,+2. ) 

CALL  (^AFIT  (1,PIM,  PIP,  X200,  X900,  PIM,  PIP,  -2.0,  +2.0, 
YlOO,  Y800,  -2.0,  +2.0,  'X  AXIS1.',  3,  YAXIS,  5) 

CALL  C0L0R(4) 

X450  = XMIN  + .45  * DX 

X650  = XMAX  - .35  * DX 

Y200  = YMIN  + .30  * DY 
Y500  = YMAX  - .40  * DY 
CALL  GRILAB(2,PIM,-2. ,PIP,+2. ) 

CALL  GRAFIT  (2, PIM,  PIP,  X450,  X650,  PIM,  PIP,  -2.0,  +2.0, 
Y200,  Y500,  -2.0,  +2.0,  'XAXISl.',  3,  ’YAXISV’,  5) 

XOFF  = (PIP  - PIM)  / 10. 

DO  2 I = 1,  10 

XI  = PIM  + FLOAT(I-l)  * XOFF 
YI  = COS(XI) 

X(I)  = XI 

Y(I)  = YI 

CALL  COLOR(l) 

CALL  PLOTLN  (1,  X,  Y,  10) 

CALL  CHRSIZ(0.  , .05) 

CALL  PLOTCH  ( 1 , X, Y , 10, ' *A ' ) 

CALL  PLOTLN  (2,  X,  Y,  10) 

CALL  PLOTCH  (2 , X, Y, 10, LC) 

CALL  FRAME 
LF(LD.EQ.  3)  PAUSE 
CONTINUE 
CALL  ENDFRM 
STOP 
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SUBROUTINE  GRAFIT4(ID) 

DIMENSION  Q(550) ,VS(550) ,X(500) ,Y(500) ,TM(500) ,SQT(500) 

CHARACTER* 16  FILE 

CHARACTER*40  TITLE/ 'GRAFIT(4) '/ 

FILE  = 'G1TEST4.DAT' 

TSTAR  = 10. 

B = .321 

OPEN  (UNIT=8,FILE=FIL£) 

NP=0 
Nl  = l 

6 READ(8,3,END=5)  N 

3 FORMAT(I2) 

READ(8,4)  (VS(J),Q(J) ,TM( J) , J=1 , N) 

DO  10  1=1, N 
FT=B*SQRT(TM(I)) 

IF(TM(I).GT.TSTAR)  FM=1. 

10  SQT(I)=Q(I)*FT 

4 F0RMAT(50X,3F10. 2) 

N2=NP+(N-2) 

J=1 

DO  8,  I=N1,N2 
Y(I)=VS(J) 

X(I)=SQT(J) 

8 J=J+1 
NP=N2 
N1=NP+1 
GO  TO  6 

5 CONTINUE 
TYPE  *,  TITLE 
NP=N2 

CALL  PLT(NP,X,Y) 

IF(II>.  EQ.  1)  GO  TO  50 
PAUSE 

50  CONTINUE 
CALL  ENDFRM 
STOP 
END 
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SUBROUTINE  PLT(N,X,Y) 

DLMENSION  X( 5 50 ) , Y( 550) 

CHARACTER*40  TITL 
CHARACTER*25  YLABL 
CHARACTER*25  XLABL 

TITL  = ' Rigid  Foaml.  ' 

XLABL='q  . F(c)  (W/cm1U2lO) 1. ' 

YLA3L=’i/  V (s/oim)1.'  . 

ymax  = 2.0 

lYTIC  = 10 

CALL  NEWFRM 

CALL  COLOR(l) 

CALL  GRISET(0.  ,0.  , 1100.  , 1100. ) 

CALL  COLOR(8) 

CALL  GRAFIT(1,0. ,6. ,200. ,900. ,0. ,6. ,0. , YMAX, 200. ,900. ,0. ,YMAX, 
&XLABL,6,YLABL, lYTIC) 

CALL  COLOR(l) 

CALL  R.0TCH(1,X,Y,N, 'o' ) 

CALL  COLOR(5) 

CALL  LABEL(TITL, 2 50. ,950. ,850. , 1000.  ,0.0) 

CALL  FRAME 

RETURN 

END 
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606 

SUBROUTINE  PHASE 

607 

DLMENSION  Z(30,30),  X(8),Y(8),  FL(8),  TEST(30,30) 

608 

EATA  A/1./,  B/-4./,  C/5./,  NINT/8/ 

609 

DATA  X/100.,  800.,  250.,  950.,  100.,  800., 

250. , 950 

610 

DATA  Y/lOO,  , 100.,  300.,  300.,  800.,  800., 

950.,  950 

611 

C 

612 

DO  1 I = 1,30 

613 

DO  1 J = i,  30 

614 

1 

Z(I,J)  = A*C0S(-.4+FL0AT(I)/5. )* 

615 

. (l.+B*EXP(-C*(FLOAT(J-10)/7. )**2))+5 

616 

ZMAX  = -l.E+9 

617 

ZMIN  = +1.E+9 

618 

DO  4 I = 1,  30 

619 

DO  4 J = 1,  30 

620 

ZMAX  = MAX(ZMAX,  Z(I,J)) 

621 

4 

ZMIN  = MIN(ZMIN,  Z(I,J)) 

622 

CALL  LINWID(l) 

623 

CALL  NEWFRM 

624 

CALL  DEFINE(0. ,-100, , 1000. , 1000. ) 

625 

CALL  SRFSET(X,Y,0. , 10. ,30,30) 

626 

CALL  C0L0R(2) 

627 

CALL  SURFAC(Z,30,30, 1) 

628 

CALL  C0L0R(3) 

629 

CALL  SURFAC(Z, 30, 30,-1) 

630 

C 

631 

C 

SET  UP  A REASONABLE  CONTOURING  INTERVAL 

632 

c 

633 

CALL  CNTSET(X(1),Y(1),X(2),Y(2),X(4) , Y(4 ) , X( 3 ) , Y( 3 ) ) 

634 

DELTAZ  = (ZMAX  - ZMIN)  * 0.9  / FLOAT  (NINT) 

635 

FL(1)  = ZMIN  + 0. 5 * DELTAZ 

636 

DO  2 I = 2,  8 

637 

2 

FL(I)  = FL(I-l)  ■+  DELTAZ 

638 

DO  3 I = 1,  8 

639 

CALL  COLOR(I) 

640 

3 

CALL  CONTUR  (Z,  TEST,  30,  30,  FL(I)) 

641 

CALL  FRAME 

642 

PAUSE 

643 

CALL  ENDFRM 

644 

STOP 

645 

END 
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SUBROUTINE  RUMTST 

COMMON/ ROOMSZ/RML,RMR,RMB,RxMT,SCAL£(  4)  .WALLSZ  ,CEILSZ 
REAL*4  LSIZE,  DELTA 
CALL  NEWFRM 
CALL  FILTYP(2) 

CALL  ROOM  (0.0,  5.0,  0.0,  2.5,  .05,  1.0,  0.7) 

CALL  VENTV  (0.1,  0.5,  0.0,  -1.) 

A = -1.5  / 20. 

B = 2. 2 - A 
I = 1 

FSIZE  = FLOAT(I)*A  + B 
LSIZE  = FSIZE  + 0.2 
PSIZE  = FSIZE 

CALL  FIRE  (4.0,  0.5,  0.2,  FSIZE) 

CALL  PLUME  (4.0,  0.5,  0.5,  PSIZE,  0.2) 

CALL  LAYER  (0.05,  2.45,  4.95,  2.48) 

CALL  FRAME 
CALL  lOWAIT(lOOO) 

DELTA  = -A 
DO  101  I = 1,  21 

CALL  FIRE  (4.0,  0.5,  0.2,  FSIZE) 

CALL  PLUME  (4.0,  0.5,  0.5,  PSIZE,  0.2) 

FSIZE  = FLOAT(I)*A  + B 
LSIZE  = FSIZE  + 0.2 
PSIZE  = FSIZE 

CALL  FIRE  (4.0,  0.5,  0.2,  FSIZE-2*DELTA) 

CALL  PLUME  (4.0,  0.5,  0.5,  PSIZE-DELTA,  0.2) 

CALL  LAYER(0.05,  LSIZE-DELTA,  4.95,  2.48) 

CALL  FRAME 
CALL  lOWAIT(lOOO) 

CONT INUE 
PAUSE 

CALL  ENDFRM 

STOP 

END 
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SUBROUTINE  VENTV  (BOTH,  TOP,  SIDE,  THICK) 

COMMON/ ROOMSZ / RML , RMR , RMB , RMT , SCALE ( 4 ) , WALLS  Z , C E I LS  Z 
REAL  BOTM,  TOP,  SIDE 

DRAW  VERTICAL  LINES  IN  BLACK  AND  HORIZONTAL  LINES  IN  WHITS 


Y1  = 

BOTM 

Y2  = 

TOP 

DO  2 

I = 1 

, 2 

XI  = 

SIDE 

+ (I-i)  * WALLSZ  * THICK 

X2  = 

XI 

CALL 

LINE 

(XI,  Yl,  X2,  Y2) 

XI  = 

SIDE 

X2  = 

WALLSZ  *■  THICK 

DO  1 

I = 1 

, 2 

Y1  = 

BOTM 

+ (I-l)  * (TOP-BOTM) 

Y2  = 

Y1 

CALL 

LINE 

(XI,  Yl,  X2,  Y2) 

RETURN 

END 
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701  SUBROUTINE  LAYER  (LEFT,  BOTTOM,  RIGHT,  TOP) 

702  C 

703  C DRAW  SQUIGGLE  FROM  LEFT  TO  RIGHT  TO  REPRESENT 

704  C THE  LAYER  (HOT)  ABOVE  THE  PLUME 

705  C 

70b  INTEGER  DIVCNT 

707  REAL  LEFT,  RIGHT,  BOTTOM,  TOP,  X(4),  Y(4) 

708  C 

7j9  C now  draw  THE  SQUIGGLE 

710  C 

711  CALL  C0L0R(2) 

712  X(l)  = LEFT 

713  Y(l)  = BOTTOM 

714  X(2)  = LEFT 

715  Y(2)  = TOP 

716  X(3)  = RIGHT 

717  Y(3)  = TOP 

713  X(4)  = RIGHT 

719  Y(4)  = BOTTOM 

720  CALL  PLYGON(X,  Y,  4) 

721  RETURN 

722  END 
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SUBROUTINE  FIRE  (CENTER,  WIDTH,  HEIGHT,  FSIZE) 

COMMON/ ROOMSZ/ RML , RMR , RMB , RMT , SCALE ( 4 ) , WALLS  Z , CEILSZ 
C 

C PLOT  THE  FIRE  SOURCE 
C 

CALL  COLOR(3) 

CALL  VBXPLT  (CENTER-.  5*WIDTH,  0.0, 

CENTER+. 5*WIDTH, HEIGHT) 

C 

C START  AT  HEIGHT  [HP=( 1 +EPS ) *H£IGHT ] AND  TRACE  THE  PARABOLA 
C 

CALL  COLOR(8) 

HP  = 1.2  * HEIGHT 
W5  = WIDTH  * . 5 
SLOPS  = FSIZE  / W5**2 
W20  = WIDTH  / 20. 

YB  = HP 

XB  = CENTER  - W5 

DO  1 I = 1,  21 

XA  = XB 

YA  = YB 

XB  = CENTER  - W5  + W20*  FLOAT(I-l) 

YB  = -(XB-CENTER)**2*SLOPE  + HP  + FSIZE 
1 CALL  LINE  (XA,  YA,  XB , YB) 

RETURN 

END 
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749 

7 30  C 

751  C 

752  C 
7 53  C 

754  C 

755  C 
7 5b  C 

757 

758 

759  C 
7b0  C 

761  C 

762 

763 

764  C 

765 

766  C 

767  C 

768  C 

769  C 

770  C 

771 

772 

773 

774 

775 

776 
111 

778 

779 
7 80 


SUBROUTINE  PLUME  (CENTER,  WIDTH,  PBOTM,  PTOP,  FSOURC) 

TO  PUT  THE  PLUME  III , NORMALLY  ABOVE  THE  FIRE 
THIS  ROUTINE  ASSUMES  A POINT  SOURCE  PLUME  AT  A 
VIRTUAL  DISTANCE  BELOW  THE  FIRE  SUCH  THAT  THE 
PLUME  SUBTENDS  AN  ANGLE  OF  li  DEGREES  AT  THE  FIRE 
SOURCE. 

REAL  CENTER,  WIDTH,  PBOTM,  PTOP,  FSOURC 

COMMON/ ROOMSZ / RML , RMR , RMB , RMT , SCALE ( 4 ) , WALLSZ , CE ILS  Z 

PLOT  THE  PLUME 

RADIUS  = 0.  5 * WIDTH 

THETA  = 11.  / 57. 1 

VIRTUAL  = RADIUS  / ATAN(THETA) 

RTAN  = ATAN  (THETA) 

DRAW  TWO  LINES  FROM  THE  VIRTUAL  POINT  WITH  AN  ANGLE 
OF  THETA  AND  VISIBLE  SEGMENTS 
FROM  PBOTM  TO  PTOP 

CALL  COLOR(7) 

Y1  = PBOTM 
Y2  = PTOP 
DO  1 I = 1,  2 
PM  = (-1.0)**! 

XI  = CENTER  + PM*(RADIUS+(PBOTM-FSOURC)*RTAN) 

X2  = CENTER  + PM*(RADIUS+(PTOP  -FSOURC )*RTAN) 

1 CALL  LINE  (XI,  Yl,  X2,  Y2) 

RETURN 

END 
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SUBROUTINE  ROOM  (L,  R,  B,  T,  DW , FW , FH) 

REAL  L,  R,  T,  B,  F,  SCAL£(4) 

COMMON/  ROOMSZ / RML , RMR , RMB  , RMT , SCALE  , WALLS Z , C E I LS Z 
C 

C - L = LEFT  SIDE  OF  ROOM 
C - R = RIGHT  SIDE  OF  ROOM 
C - T = TOP  OF  THE  ROOM 
C - B = BOTTOM  OF  THE  ROOM 
C - DW  = WIDTH  OF  WALL 

C - F IS  THE  FRACTION  OF  THE  SCREEN  TO  BE  USED 
C 


1 


XFW  = AMINl  (1.  , FW) 

XFH  = AMINl  (1.  , FH) 

DWMIN  = AMINl  (R-L,  T-B) 

WALLS Z = DWMIN  * DW 

CEILSZ  = 0.5  * XFW/XFH  * WALLSZ 

DY  = T - B 

DX  = R - L 

XL  = L - DX/3.5 

XR  = R + DX/3.5 

XB  = B - DY/3.5 

XT  = T + DY/3.5 

CALL  DEFINE  (XL,  XB , XR,  XT) 

CALL  COLOR(l) 

DO  1 IW  = 1,  2 

WALL  = WALLSZ  * (IW-1) 

CEIL  = CEILSZ  * (IW-1) 

XL  = L - WALL 
XR  = R + WALL 
XB  = B 

XT  = T + CEIL 

CALL  BOXPLT  (XL,  XB , XR , XT) 

RETURN 

END 
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815  SUBROUTINE  SADDLE(ID) 

8 i D C 

817  C PROGRAM  TO  TEST  THE  SURFACE  PLOTTING  AND  CONTOUR  ROUTINES. 


818  C 

819  PARAMETER  (NX=25, NY=1 3, NP=4) 

820  REAL  Z(NX,NY),  XP(8 , 9) , YP(8 , 9) , FL(16),  TEST(NX,NY) 

821  INTEGER  INDX(NP) 


822 

DATA 

ZMIN, 

ZMAX 

823 

DATA 

INDX/1,3,7, 

824 

DATA 

XP/ 

825 

1 

100.  , 

800.  , 

826 

2 

100.  , 

900.  , 

827 

3 

200.  , 

900.  , 

828 

4 

100.  , 

800.  , 

829 

5 

100.  , 

900.  , 

830 

6 

200.  , 

900.  , 

831 

7 

100.  , 

800.  , 

832 

8 

100.  , 

900.  , 

833 

9 

200.  , 

900.  , 

334 

DATA 

YP/ 

835 

1 

100.  , 

c 

o 

836 

2 

100.  , 

100.  , 

837 

3 

100.  , 

100.  , 

838 

4 

100.  , 

100.  , 

839 

5 

100.  , 

• 

o 

o 

840 

6 

100.  , 

100.  , 

841 

7 

200.  , 

200.  , 

842 

8 

200.  , 

200.  , 

843 

844  C 

9 

200.  . 

200.  , 

/-0.75,  200./,  MX,  MY  /I,  1/ 
9/ 


250.  , 

900.  , 

100.  , 

800.  , 

250.  , 

900.  , 

200.  , 

800.  , 

100.  , 

900.  , 

200.  , 

800.  , 

100.  , 

750.  , 

200.  , 

900.  , 

100.  , 

750.  , 

250.  , 

900.  , 

100.  , 

800.  , 

250.  , 

900.  , 

200.  , 

800.  , 

100.  , 

900.  , 

200.  , 

800.  , 

100.  , 

750.  , 

200.  , 

900.  , 

100.  , 

750. , 

250.  , 

900.  , 

100.  , 

800.  , 

250.  , 

900.  , 

200.  , 

800.  , 

100.  , 

900.  , 

200.  , 

800.  , 

100.  , 

750.  , 

200.  , 

900.  , 

100.  , 

750./ 

250. , 

250.  , 

800.  , 

800.  , 

900.  , 

900.  , 

250.  , 

250.  , 

800.  , 

800.  , 

900. , 

900.  , 

250.  , 

250.  , 

800.  , 

800.  , 

900.  , 

900.  , 

200.  , 

200.  , 

900.  , 

900.  , 

800.  , 

800.  , 

200.  , 

200.  , 

900.  , 

900.  , 

800.  , 

800.  , 

200.  , 

200.  , 

900.  , 

900.  , 

800.  , 

800.  , 

100.  , 

100.  , 

900.  , 

900.  , 

750.  , 

750.  , 

100.  , 

100.  , 

900.  , 

900.  , 

750.  , 

750.  , 

100.  , 

100.  , 

900.  , 

900.  , 

750.  , 

750./ 

845  C 

846  C 
84  7 

848 

849 

850 


INITIALIZE  THE  DATA 

DO  20  J = 1,  NY 
DO  20  I = 1,  NX 

Z(I,J)  = ABS(FLOAT(J)-7.  )**2  + ( 144. -ABS(FLOAT(I)-13. )**2) 
20  CONTINUE 


851  DO  2 I = 1,  8 

852  FL(I)  = -1.0  + FLOAT(I)*10. 

853  2 FL(I+8)  = 0. 2 + FLOAT(I)*10. 

8 54  C 

855  C INITIALIZE  THE  GRAPHICS  PACKAGE 

856  C 

857  CALL  DEFINE  (0.,  0.,  1023.,  1023.) 

858  CALL  NEWFRM 

859  C 


860  C LOOP  OVER  THE  VARIOUS  PERSPECTIVE  PLOTS. 

861  C 

862  IPP  = 3 

863  DO  100  IPP  = 1,  NP 

864  IP  = INDX(IPP) 

865  C 

866  C PLOT  THE  UPPER  PART  OF  THE  SURFACE  WITH  FRONT  SKIRT. 

867  C 

868  CALL  SRFSET  (XP(1,IP),  YP(1,IP),  ZMIN,  ZMAX,  NX,  NY) 

869  CALL  ERASE 
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870 

871 

872 

873 

874 

875 

876 

877 

878 

879 

880 

881 

882 

883 

884 

885 

886 

887 

888 

889 

890 

891 

892 

893 

894 

895 

896 

897 

898 

899 

900 

901 

902 

903 

904 

905 

906 

907 

908 
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CALL  SETLUT 
CALL  COLOR(5) 

CALL  SURFAC  (Z,  NX,  NY,  +1) 

CALL  COLOR(4) 

CALL  SFRAME  (2) 

CALL  FRAME 
CALL  IOWAIT(2000) 

C 

C PLOT  THE  LOWER  PART  OF  THE  SURFACE. 

C 

CALL  SRFSET  (XP(1,IP),  YP(1,IP),  ZMIN,  ZMAX,  NX,  NY) 
CALL  ERASE 
CALL  C0L0R(7) 

CALL  SURFAC  (Z,  NX,  NY,  -1) 

CALL  COLOR(4) 

CALL  SFRAME  (2) 

CALL  FRAME 
CALL  IOWAIT(2000) 

C 

C PLOT  BOTH  PARTS  OF  THE  SURFACE  WITH  SIDE  SKIRTS. 

C 

CALL  SRFSET  (XP(1,IP),  YP(1,IP),  ZMIN,  ZMAX,  NX,  NY) 
CALL  ERASE 
CALL  COLOR(5) 

CALL  SURFAC  (Z,  NX,  NY,  +1) 

CALL  COLOR(7) 

CALL  SURFAC  (Z,  NX,  NY,  -1) 

CALL  SFRAME  (2) 

CALL  FRAME 
IF(ID.EQ. 3)  THEN 
PAUSE 
ELSE 

CALL  IOWAIT(2000) 

ENDIF 

100  CONTINUE 

CALL  ENDFRM 


C 


STOP 

END 
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909 

910 

911 

912 

913 

914 

913 

9lo 

917 

913 

919 

920 

921 

922 

923 
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SUBROUTINE  SETCOL(IC) 
DIMENSION  LUT(16,3) 

DO  1 I = 1,  3 
DO  1 J = 1,  16 
LUT(J,I)  = 0 
DO  2 I = 1,  8 
LUT( 1+1,2)  =1*2-1 
LUT(I+1,3)  = 1*2  - r 
DO  3 I = 1,  7 
LUT(I+9, 1)  = 1*2  + 1 
LUT(I+9,2)  =1*2+1 
CALL  DSLWT  (16,  48,  LUT) 
RETURN 
END 
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925 

926 

927 

928 

929 

930 

931 

932 

933 

934 

935 

936 

937 

938 

939 

940 

941 

942 

943 

944 

945 

946 

947 

948 

949 

950 

951 
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955 
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SUBROUTINE  SYMTST 
C 

C A SIMPLE  TEST  OF  THE  CHARACTER  STUFF 
C 

CHARACTER*28  TITLE  1/ 'A  SET  OF  HARDWARE  CHARACTERS'/ 
CHARACTER*19  TITLE2/’U  SET  FROM  SET  11.'/ 

CHARACTER*32  TITLE3/'1:A  SET  ([§/*t])  FROM  SET  #101.'/ 
ISC=0 

3 XSZ  = 11.  * 2.**ISC  - 11. 

CALL  NEWFRM 

CALL  DEFINE(-XSZ,  -XSZ,  ll.+XSZ,  ll.+XSZ) 

CALL  C0L0R(4) 

CALL  BOXPLT  (0.5,  0.5,  8.5,  4.5) 

CALL  BOXPLT  (0.5,  5.5,  8.5,  9.5) 

CALL  BOXPLT  (9.0,  0.5,  10.7,  9.5) 

DX  = 5.  / 28. 

XL  = 4.5  - 14.*DX 
CALL  COLOR(l) 

CALL  CHRSIZ  ( DX/ ( 1 1 . +2 . *XSZ) , 0.  ) 

DO  1 I = 1,  28 

1 CALL  SYMBOL  (XL+DX*FLOAT(I) , 7.5,  TITLE1(I:I)) 

CALL  COLOR(3) 

CALL  LABEL(TITLE2,  2.0,  2.0,  8.0,  2.5,  0.0) 

CALL  COLOR(2) 

CALL  LABEL(TITLE3,  10.3,  1.,  17.3,  2.,  3.14/2.) 

CALL  FRAME 
CALL  IOWAIT(2000) 

ISC  = ISC  + 1 
IF(ID.NE.3)  GO  TO  4 
IF(ISC.GT.7)  GO  TO  4 
GO  TO  3 

4 CALL  ENDFRM 
STOP 
END 
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9 58  SUBROUTINE  VOLTST(ID) 

959  C 


9b0  C VOLU'ME  TEST  PROGRAM  WITH  REDUCED  RESOLUTION  HIDDEN  LINES. 


961  C 

962  C 

963  C 

964  C 

965  C 

966  C 

967  C 

968  C 

969  C 

970 

971 

972 

973 
9 74 


THIS  PROGRAM  DEMONSTRATES  THE  USE  OF  THE  "VOLUME"  PLOTTER. 

IT  USES  A SIMPLE  SOLID  ( TWO  OVERLAPPING  SPHERES) 

WITH  A SOLID  PILLAR  PLACED  IN  FRONT  TO  OBSCURE  PART  OF  THE 
SPHERES  AND  DEMOSTRATE  THE  HIDDEN  LINE  FEATURE.  THIS  IS  DONE 
TOGETHER  WITH  THE  NECESSARY  INTERACTION  WITH  THE  GRAPHICS 
PACKAGE.  THIS  SHOULD  BE  USED  AS  A MODEL  FOR  DESIGNING  PROGRAMS  UN 
THE  USER  IS  FAMILIAR  WITH  VOLUME. 


PARAMETER  (NT=100,  NT2=NT*NT) 
REAL  T(NT2),  CLEVE(2) 

REAL  XP(8,3),  YP(8,3) 

REAL  F(20,  20,  20) 

INTEGER  M0DE(2) 


975 


DATA 


NX,NY,NZ  /20,  20,  20/ 


976 

DATA 

MODE 

/-i, 

2/ 

, CLEVE  /I 

.5,  -1 

.0/ 

977 

DATA 

NP, 

ITAPE 

/3 

, 105/ 

978 

DATA 

XP/ 

979 

1 

100. 

, 800. 

250.  , 

900. 

, 100. 

, 800.  , 

250.  , 

900.  , 

980 

2 

100. 

, 900. 

> 

200.  , 

800. 

, 100. 

, 900., 

200.  , 

800.  , 

981 

3 

200. 

, 900. 

9 

100.  , 

750. 

, 200. 

, 900.  , 

100.  , 

750./ 

982 

DATA 

YP/ 

983 

1 

100. 

• 

o 

o 

> 

250.  , 

250. 

, 800. 

, 800.  , 

900.  , 

900.  , 

984 

2 

100. 

, 100. 

> 

250.  , 

250. 

, 800. 

, 800. , 

900.  , 

900.  , 

985 

3 

100. 

, 100. 

y 

250.  , 

250. 

, 800. 

, 800. , 

900.  , 

900./ 

986 

987 

988 

989 

990 

991 

992 


C 

C 

C 

C 

C 

C 


INITIALIZE  THE  PACKAGE 

CALL  DEFINE(0.,  0.,  1024.,  1024.) 
LOOP  OVER  FOUR  SIZES  OF  THE  SPHERES 


993 

994 

995 

996 

997  C 

998  C 

999  C 

1000  C 

1001  C 

1002  C 

1003 

1004 

1005 

1006 

1007 

1008 

1009 

1010  C 

1011  C 

1012  C 


DO  100  IPIC  = 1,901,300 
NP  = NP 
IP  = 1 

FAC  = 1.0  + 0.01*FLOAT(IPIC) 


SET  UP  THE  VALUE  OF  THE  FUNCTION. 

IT  IS  AN  NRL  PEANUT  ( 2 OVERLAPPING  SPHERES) 
(X-13)**2  + (Y-10.5)**2  + (Z-10.5)**2 
(X-8)**2  + (Y-10.5)**2  + (Z-10.5)**2 


DO  1 I = 1,  NX 
DO  1 J = 1,  NY 
DO  1 K = 1,  NZ 

RISQ  = (I-8.0)**2  + (J-10.5)**2  + (K-10.5)**2 
R2SQ  = (1-13. )**2  + (J-10.5)**2  + (K-10.5)**2 
F(I,J,K)  = FAC/RISQ  + 2.0*FAC/R2SQ 
CONTINUE 

CONSTRUCT  THE  PILLAR 
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1013 

1014 

1015 

1016 

1017 

1018 

1019 

1020 

1021 

1022 

1023 

1024 

1025 

1026 

1027 

1028 

1029 

1030 

1031 

1032 

1033 

1034 

1035 

1036 

1037 

1038 

1039 

1040 

1041 

1042 

1043 

1044 

1045 

1046 

1047 

1048 

1049 

1050 

1051 

1052 

1053 

1054 

1055 

1056 

1057 

1058 

1059 


SUBROUTINE  VO  LIST 


page  32 


DO  2 I = 1,  NX 
DO  2 J = 1,  5 
DO  2 K.  = 1,  NZ 

RSQ  = (I-10.5)**2  + (J-3.5)**2 
F(I,J,K)  = -4.0/RSQ 
2 CONTINUE 
C 

C INITIALIZE  THE  PLOTTING  PACKAGE 

C 

C IN  THIS  CASE,  "VOLSET"  IS  CALLED  FOR  EACH  CYCLE  SO  THAT  THE 
C VARIOUS  CONTOUR  LEVELS  WILL  BE  PLOTTED.  THE  PILLAR  IS  PLOTTED 

C ONLY  ONCE(THIRD  CALL)  BUT  STUFF  BEHIND  IT  IS  ALWAYS  HIDDEN 

C (NCL=2,  MODE=2,  CLEVE=-1.). 

C 


C 

C 

C 


C 


C 


C 


C 


C 

C 

C 


CALL  NEWFRM 

DRAW  THE  FIGURE 

CALL  COLOR(l) 

CLEVE(l)  =1.5 

CALL  VOLSET  (XP(1,IP),  YP(1,IP),  T,  NT) 

CALL  VOLUME(MODE,  F,  NX,NY,NZ,  CLEVE,  2,  T,  NT) 

CALL  COLOR(2) 

CLEVE(l)  =0.5 

CALL  VOLSET  (XP(1,IP),  YP(1,IP),  T,  NT) 

CALL  VOL'UME(MODE , F,  NX,NY,NZ,  CLEVE,  2,  T,  NT) 

CALL  COLOR(3) 

CALL  VOLSET  (XP(1,IP),  YP(1,IP),  T,  NT) 

CALL  VOLUME  (+1,  F,  NX,NY,NZ,  -1.0,  1,  T,  NT) 

CALL  COLOR(4) 

CALL  VOLUME  (-2,  F,  NX,NY,NZ,  0.5,  1,  T,  NT) 
CALL  VOLFRM  (2) 

CALL  FRAME 
CALL  I0WAIT(2000) 

100  CONTINUE 

CLOSE-OUT  GRAF  IT. 


C 

IF(ID.  EQ.3)  PAUSE 
CALL  ENDFRM 
C 


STOP 

END 
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SUBROUTINE  FILNGT 
CALL  NEWFRM 

CALL  DEFINE(-11. ,-11. ,11. ,11,) 
DO  2 I = 1,  9 
CALL  FILTYP(I-l) 

X = -11.  FLOAT(I)*2.  1 
Y = -11.  + FLOAT(I)*2, 1 
CALL  CIRCLE(X,  Y,  2.0) 

CONTINUE 
CALL  FRAME 
PAUSE 

CALL  ENDFRM 

STOP 

END 
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SUBROUTINE  MABEL  (CHARS,  XL,  XR,  ANGLE) 

COMMON  /DEVTYP/  IDEVIC , LSW , LTSW , XYCOOD(4 ) , LUOUT, LPAGE 
COMMON/GRFTYP/ XNGLE , IRVRSE , CHS IZ E ( 9 ) , ITKWIT , LUDIAG , LUHSET 
CHARACTER*!  CHARS(*) 

CALL  WDC0UNT( CHARS,  NC) 

IF(NC.LE.O)  THEN 

IF( LUDIAG. GT.O)  WRITE (LUDIAG, 3)  (CHARS( I ) , 1=1 , 132 ) 

3 FORMAT ( ' NO  ESCAPE  SEQUENCE  IN  ALABEL  -’,^1X,  132A1) 

RETURN 
ENDIF 

DX  = (XR  - XL)  / MAX( 1. , FLOAT (NC)) 

DY  = 4./3.  * DX  * XYCOOD(1)/XYCOOD(3) 

XNGLE  = ANGLE 

GALL  WDDRAW  (XL,  YB , DX,  0.0,  DX,  0.0,  DY,  CHARS) 

RETURN 

END 
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SUBROUTINE  BOXPLT  (XI,  Yl,  X2,  Y2) 

C 

(]************************************************★*********************•* 


C BOXPLT 

(^*  *****************  *x  *********************  ***  *************************** 


C 


REAL  XA(4)  ,XB(4)  ,YA(4)  ,YB(4) 


C 


ENTRY  VBXPLT  (XI,  Yl,  X2,  Y2) 

XA( 1)=X1 

YA(1)=Y1 

XB( 1)=X2 

YB( 1)=Y1 

XA(2)=X2 

YA(2)=Y1 

XB(2)=X2 

YB(2)=Y2 

XA(3)=X2 

YA(3)=Y2 

XB(3)=X1 

YB(3)=Y2 

XA(4)=X1 

YA(4)=Y2 

XB(4)=X1 

YB(4)=Y1 

CALL  LINES(XA,YA,XB,YB,4) 

RETURN 

END 
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SUBROUTINE  CHPLOT 
C 

C XARRAY  REAL 

C 

C YARRAY  REAL 

C 

C CHARAC  LITERAL  - 

C II  INTEGER  - 

C 12  INTEGER  - 

C 

C 13  INTEGER  - 


(XARRAY,  YARRAY,  CHARAC , li,  12,  13) 

AN  ARRAY,  DIMENSIONED  N,  OF  X COORDINATES  OF 
THE  DATA  (MATH  SPACE) 

AN  ARRAY,  DIMENSIONED  N,  OF  Y COORDINATES  OF 
THE  DATA  (MATH  SPACE) 

CHARACTER  TO  BE  PLOTTED 
INDEX  OF  FIRST  POINT  TO  BE  PLOTTED 
INCREMENT  AT  WHICH  POINTS  ARE  TO  BE  SELECTED 
TO  PLOT 

INDEX  OF  LAST  POINT  IN  DATA  ARRAYS 


C CHPLOT 


COMMON  /DEVTYP/  IDEVIC , LSW , LTSW , XYCOOD(4 ) , LUOUT , LPAGE 
COMMON/GRFTYP/ ANGLE, IRVRSE, CHS IZ£(9) ,ITKWIT,LUDIAG,LUHSET 
INTEGER  II,  12,  13,  CHCODE 
REAL  XARRAY(4),  YARRAY(4) 

CHARACTER*!  CHARAC 

INTEGER  IX, lY 

NOPTS  = (I3-I1+I2)  / 12 

IlM  = II  - 12 

DO  1 1=1, NOPTS 

II=IIM+I2*I 

I CALL  SYMBOL  (XARRAY(  II) YARRAY(II),  CHARAC) 

RETURN 

END 
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SUBROUTINE  CIRCLE(X,  Y,  R) 

C 

C DRAW  A CIRLE  OF  WIDTH  LINWDM  AND  FILL  WITH  LFLMAT. 

C 

COMMON/DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD( 4 ) , LUOUT , LPAGE 
COMMO N/ GRFMO D/ LF LMAT ( 5 ) , L INW  DM  ( 5 ) , LC LM AT ( 5 ) 

REAL  XO,  YO,  XN,  YN,  DX,  DY,  THETA,  ARC 
C 

IF( IDEVIC. EQ.O)  RETURN 
GO  TO  (1,1, 2,  1,1),  IDEVIC 
1 ARC  = 3.  1415/50. 

THETA  =0.0 
XO  = X + R 
YO  = Y 

DO  10  I = 1,  101 
THETA  = THETA  + ARC 


XN  = 

R * COS(THETA) 

+ X 

YN  = 

R * SIN(THETA) 

+ Y 

CALL 

LINE(XO,  YO,  XN, 

YN) 

XO  = 

XN 

YO  = 

YN 

10  CONTINUE 
RETURN 

2 XL  = MAX(X  * XYCOOD(l)  + XYCOOD( 2 ) , 0. ) 
YL  = MAX(Y  * XYCOOD(3)  + XYCOOD( 4 ) , 0. ) 
RL  = R * MIN(XYCOOD( 1) , XYCOOD(3)) 

CALL  GMOVA(XL,  YL) 

CALL  GCIRA(RL) 

RETURN 

END 
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SUBROUTINE  CONTUR  (F,  TEST,  NX,  NY,  FL) 

PARAMETER  (NPT=101) 

REAL  F(NX,NY),  TEST(NX,NY) 

REAL  XTl(NPT),  XT2(NPT),  XT3(NPT),  YTl(NPT),  YT2(NPT), 

1 YT3(NPT),  FTi(NPT),  FT2(NPT),  FT3(NPT) 

REAL  TOO(NPT),  TIO(NPT),  TOl(NPT),  Til(NPT) 

C 

C SUB  ARRAYS  OUT  OF  THE  DATA  CANNOT  BE  CONTOURED.  THE 

C ENTIRE  F(I,J)  ARRAY  IS  CONTOURED  SO  A COPY  OVER  INTO  SCRATCH  SPACE 

C IS  REQUIRED  IF  ONLY  A PORTION  OF  F IS  TO  BE  PLOTTED. 

C 


c 

c 

c 

F 

REAL  ARRAY 

(NX, NY) 

THE  REAL  VALUES  OF  THE  FUNCTION  TO 
CONTOURED.  A TOPOLOGICALLY  SQUARE 
GRID  CELL  IS  ASSUMED  AND  DX  = DY  = 1 

c 

c 

TEST 

REAL  ARRAY 

(NX, NY) 

A USER  SUPPLIED  SCRATCH  ARRAY  OF 
THE  SAME  DIMENSIONALITY  AS  F. 

c 

NX 

INTEGER 

RANGE  AND  DIMENSION  OF  I IN  F(I,J). 

c 

NY 

INTEGER 

RANGE  AND  DIMENSION  OF  J IN  F(I,J). 

c 

FL 

REAL 

THE  VALUE  OF  F(I,J)  FOR  CONTOURING. 

C 

C CALCULATE  THE  AVERAGE  VALUE  OF  F AT  THE  CENTERS  OF  THE  CELLS. 
C 


NTMAX  = NPT  - 2 

NTRIA  = 0 

NXM  = NX  - 1 

NYM  = NY  - 1 

DO  200  J = 1,  NYM 

DO  200  I = 1,  NXM 

TEST(I,J)  = F(I,J).  + F(I+1,J) 

TEST(I,J)  = TEST(I,J)  + F(I,J+i) 

TEST(I,J)  = TEST(I,J)  + F(I+1,J+1) 

200  TEST(I,J)  = 0. 25*TEST(I, J) 

C 

C NOW  CALCULATE  THE  CROSSINGS  WHICH  PARELLEL  THE  "I”  AXIS. 

C 

DO  310  J = 1,  NY 
DO  300  I = 1,  NXM 

300  TOO(I)  = (F(I+i,J)  - FL)*(FL  - F(I,J)) 

C 

C A CROSS  OCCURS  IF  THE  CONTOUR  PASSES  THRU  F(I,J)  IN  THE  BOX  I->I+1 
C 

DO  309  I = i,  NXM 
IF  (TOO(I)  .LT.  0.0)  GO  TO  309 
C 

C THE  LINE  SEGMENT  IS  A HIT.  TREAT  IN  A SCALAR  WAY  FIRST  THE  UPPER 
C AND  THEN  THE  LOWER  TRIANGLE. 

C 

IF  (J.EQ.NY)  GO  TO  305 

IF  (NTRIA  .GE.  NTMAX)  CALL  PROPOL  (NTRIA,  XT1,YTI,FT1, 

1 XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 

NTRIA  = NTRIA  + 1 
XTl(NTRIA)  = FLOAT(I) 

YTl(NTRIA)  = FLOAT(J) 

FTl(NTRIA)  = F(I,J) 

XT2(  NTRIA)  = FLOATd  + 1) 
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305 


YT2(NTRIA)  ^ 
FT2(NTRIA)  ^ 
XT3(NTRIA)  ^ 
YT3(NTRIA)  ^ 
FT3(NTRIA)  ^ 
IF  (J,EQ. 1) 


= FLOAT(J) 

= F(I+1,J) 

= FLOAT(I)  + 
= FLOAT(J)  + 
= TEST(I.J) 
GO  TO  309 


0.5 

0.5 


If  (NTRIA  .GE.  NTMAX)  CALL  PRO POL  (NTRIA,  XT1,YT1,FT1 
XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 

NTRIA  = NTRIA  + 1 

1) 


309 

310 


XT  1(  NTRIA) 

YT1( NTRIA) 

FTl(NTRIA) 

XT2( NTRIA) 

YT  2 (NTRIA) 

FT2(NTRIA) 

XT3(NTRIA) 

YT3(NTRIA) 

FT 3 (NTRIA) 

CONTINUE 

CONTINUE 


FL0AT(I  + 

FLOAT(J) 

F(I+1,J) 

FLOAT(I) 

FLOAT(J) 

F(I,  J) 

FLOAT(I) 

FLOAT(J) 


+ 0.5 
- 0.5 


= TEST(I,J-1) 


NEXT  CALCULATE  THE  CROSSINGS  ALONG  THE  "J"  AXIS. 


C 

c 

c 

c 


DO  360  J = 1,  NYM 
DO  350  I = 1,  NX 

350  Tll(I)  = (F(I,J+1)  - FL)*(FL  - F(I,J)) 

CORSS  OCCURS  IF  THE  CONTOUR  VALUE  PASSES  THRU  THE  BOX  IN  F(I,J) 
IN  THE  RANGE  J->J+1 

DO  359  I = 1,  NX 

IF  (Tll(I)  .LT.  0.0)  GO  TO  359 

THE  LINE  SEGMENT  IS  A HIT.  TREAT  IN  A SCALAR  WAY  FIRST  THE  RIGHT 
AND  THEN  THE  LEFT  TRIANGLE. 

IF  (I.EQ.NX)  GO  TO  355 

IF  (NTRIA  .GE.  NTMAX)  GALL  PROPOL  (NTRIA,  XT1,YT1,FT1, 

1 XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 

NTRIA  = NTRIA  + 1 
XT  1 (NTRIA)  = FLOAT(I) 

YTl(NTRIA)  = FLOAT(J  + 1) 

FTl(NTRIA)  = F(I,J+1) 

XT2( NTRIA)  = FLOAT(I) 

YT2(NTRIA)  = FLOAT(J) 

FT2(NTRIA)  = F(I,J) 

XT3(NTRIA)  = FLOAT(I)  +0.5 

YT3(NTRIA)  = FLOAT(J)  +0.5 

FT3(NTRIA)  = TEST(I,J) 

355  IF  (I.EQ. 1)  GO  TO  359 

IF  (NTRIA  .GE.  NTMAX)  CALL  PROPOL  (NTRIA,  XT1,YT1,FT1, 

1 XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 

NTRIA  = NTRIA  + 1 
XTl(NTRIA)  = FLOAT(I) 

YTl (NTRIA)  = FLOAT(J) 


-147- 


219 

2 20 

22L 

222 

223 

224 

225 

226 

227 

223 

229 

230 

231 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

2 50 

251 

252 

253 

254 

255 

256 

257 

258 

259 

260 

261 

262 

263 

264 

265 

266 

267 

268 

269 

270 

271 

272 

273 


SUBROUTINE  CONTUR 


359 

360 


FTl(NTRIA) 

XT2(NTRIA) 

YT2(NTRIA) 

FT2(NTRIA) 

XT3(NTRIA) 

YT3(NTRIA) 

FT3(NTRIA) 

CONTINUE 

CONTINUE 


•F(I,J) 

FLOAT(I) 
FLOAT(J  + 1) 
F(I,J+1) 
FLOAT(I)  - 0.5 
FLOAT(J)  +0.5 
TEST(I-1, J) 


420 


NOW  SEEK  ALL  TRIANGLES  WITH  TWO  DIAGONAL  CROSSINGS, 

DO  490  J = 1,  NYM 
DO  420  I = 1,  NXM 

TOO(I)  = (TEST(I,J)  - FL)*(FL  - F(I,J)) 

TIO(I)  = (FL  - TEST(I,J))*(F(I+1,J)  - FL) 

TOl(I)  = (FL  - TEST(I,J))*(F(I, J+1)  - FL) 

Tll(I)  = (TEST(I,J)  - FL)*(FL  - F(I+l,J+i)) 


CONSIDER  THE  LOWER  TRIANGLE  IN  THE  SQUARE. 

DO  430  I = 1,  NXM 

IF  (AMINKTOO(I)  , TIO(D)  .LT.  0.0)  GO  TO 
IF  (NTRIA  .GE.  NTMAX)  GALL  PROPOL  (NTRIA, 
XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 
NTRIA  = NTRIA  + 1 


430 
XTl , 


YTl.FTl 


430 


XTl (NTRIA) 
YTl (NTRIA) 
FT 1 (NTRIA) 
XT2(NTRIA) 
YT2( NTRIA) 
FT2( NTRIA) 
XT3( NTRIA) 
YT3( NTRIA) 
FT3( NTRIA) 
CONTINUE 


FLOAT(I)  + 
FLOAT(J)  + 
TEST(I, J) 
FLOAT(I) 
FLOAT(J) 
F(I,J) 
FLOAT(I  + 
FLOAT(J) 
F(I+i,J) 


0.5 

0.5 


i) 


CONSIDER  THE  RIGHT  TRIANGLE  IN  THE  SQUARE. 

DO  440  1=1,  NXM 

IF  (AMIN1(T10(I) , Tll(I))  ,LT.  0.0)  GO  TO 
IF  (NTRIA  .GE,  NTMAX)  CALL  PROPOL  (NTRIA, 
XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 
NTRIA  = NTRIA  + 1 


440 
XTl . 


YTl.FTl 


440 


XTl(NTRIA) 
YTl (NTRIA) 
FTl(NTRIA) 
XT2(NTRIA) 
YT2(NTRIA) 
FT2(NTRIA) 
XT3(NTRIA) 
YT3(NTRIA) 
FT3(NTRIA) 
CONTINUE 


FLOAT(I)  +0.5 
FLOAT(J)  +0.5 
TEST(I, J) 
FLOATd  + 1) 
FLOAT(J) 
F(I+1,J) 
FLOAT(I  + 1) 
FLOAT(J  + 1) 
F(I+1, J+1) 
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SUBROUTINE  CONTUR 


CONSIDER  THE  UPPER  TRIANGLE  IN  THE  SQUARE. 

DO  450  I = 1,  NXM 

IF  (AMINKTl  1(1) , TOl(D)  .LT.  0.0)  GO  TO 
IF  (NTRIA  .GE.  NTMAX)  CALL  PRO POL  (NTRIA, 
XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 
NTRIA  = NTRIA  + 1 


450 

XTl 


YTl.FTl 


450 


XTl (NTRIA) 
YT1( NTRIA) 
FTl(NTRIA) 
XT 2 (NTRIA) 
YT  2 (NTRIA) 
FT2(NTRIA) 
XT3(NTRIA) 
YT3( NTRIA) 
FT3(NTRIA) 
CONTINUE 


FLOAT(I)  +0.5 
FLOAT(J)  +0.5 
TEST(I, J) 
FL0AT(I  + 1) 
FLOAT(J  + 1) 
F(I+1, J+1) 
FLOAT(I) 
FLOAT(J  + 1) 
F(I,J+1) 


CONSIDER  THE  LEFT  TRIANGLE  IN  THE  SQUARE. 

DO  460  I = 1,  NXM 

IF  (AMINl(TOUI)  , TOO(I))  .LT.  0.0)  GO  TO  460 
IF  (NTRIA  .GE.  NTMAX)  CALL  PROPOL  (NTRIA,  XT1,YT1,FT1, 
XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 

NTRIA  = NTRIA  + 1 

0.5 
0.5 


460 

490 


XTl (NTRIA) 

YTl (NTRIA) 

FTl(NTRIA) 

XT2(NTRIA) 

YT2( NTRIA) 

FT2(NTRIA) 

XT3(NTRIA) 

YT3(NTRIA) 

FT3(NTRIA) 

CONTINUE 

CONTINUE 


= FLOAT(I)  + 
= FLOAT(J)  + 
= TEST(I,J) 

= FLOAT(I) 

= FLOAT (J  + 

= F(I,J+1) 

= FLOAT(I) 

= FLOAT(J) 

= F(I,J) 


1) 


IF  THE  BUFFER  IS  ONLY  PARTIALLY  FULL,  FLUSH  AT  THE  END. 

IF  (NTRIA  .GT.  0)  CALL  PROPOL  (NTRIA,  XT1,YT1,FT1, 
XT2,YT2,FT2,  XT3,YT3,FT3,  FL,  NX,  NY) 


RETURN 


END 
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SUBROUTINE  DEVICE  (N) 


DEVICE  1 CALCOKP  PLOTTER 

2 PRINTER  PLOT 

3 LEXIDATA  DISPLAY  UNIT  WITH  MATRIX  CAMERA 

4 ADM  WITH  RETROGRAPHICS  OR  TEX  40XX  SERIES 

5 EMPTY  SLOT 


COMMAN  DS 


DEVICE  - SELECT  DEVICE  (1-5) 

SETDEV  - SET  THE  LOGICAL  UNITS  FRO  OUTPUT 
LINWID  - NUMBER  OF  STROKES  IN  A LINE 
FILTYP  - TYPE  OF  FILLING  FOR  POLYGONS  AND  CIRCL 
CHRSIZ  - HEIGHT  OF  CHARACTERS  (IN  RASTER  UNITS) 


1 NEWFRM  - SET  UP  DEVICE  FOR  A NEW  PLOT 

2 FRAME  - FORCE  A FLUSH  OF  ALL  BUFFERS 

3 ERASE  - ERASE  THE  SCREEEN 

4 HDCOPY  - HARD  COPY  COMMAND  - SHUTTER  ON  MATRIX 

5 COLOR  - SELECT  THE  COLOR  TO  DRAW 

6 SCALE  - SCALE  FOR  PHYSICAL  DEVICE 

7 ENDFRM  - TERMINATE  THE  DEVICE  AND  ADVANCE 


DEFAULT  DEVICE  ASSIGNMENTS 
TYPE 

DIAGNOSTICS 

GRAPHICS 

CAMERA 

CHARACTER  SET 
CALCOMP 
PRINTER 
LEXIDATA 
MATRIX  CAMERA 
TEKTRONIX 
OPEN  SLOT 
CONSOLE  INPUT 
CHARACTER  SET 
TABLET  INPUT 


LU  RESULT 

0 NO  OUTPUT 

7 NORMAL  - ASSIGNED 

8 ASSIGNED  WITH  LEXIDATA 

0 UNIT  0 - ASSIGNED 

L7:  RS232  LINE 

PR:  WHATEVER 

LEX:  DMA  (L34DVR  IN  SYSTEM) 

LE:  RS232 

C:  CONSOLE 

NULL:  BIT  BUCKET 

5 

9 (CLOSED  THEN  OPENED) 

8 (CLOSED  THEN  OPENED  - 
CAMERA  AND  TABLET  CAN 
NOT  BE  ACTIVE  SIMULTANEOUSLY) 


INTEGER  LB,  COUNT(5),  NFRAME(5),  PEN,  COMMND,  DEVID,  PBLK(6) 

CHARACTER*8  IDFLTO(5),  MATFIL,  TABFIL 

INTEGER  ICODET(2),  ICTRLX(2),  ICHANX(2,2),  SCRATCH(60) 

INTEGER  HBLANK,  HMINUS , HAPOSA,  HAPOSB , HASTRA,  HASTRB , NHOLD 
INTEGER  VSNUM(2),  TEKRAS(4),  LEXRAS(4),  HWSIZE(20),  CALRAS(4) 
INTEGER  LPAGE(30,65) , START,  LINE,  SLASH,  ENDIT 
INTEGER  MATUNT,  TABUNT,  USPAT(12,4) 

LOGICAL  LSW,  LTSW,  OPEN,  OPENANY,  OPNCAL,  OPNLEX,  IRVRSE 
LOGICAL  OPNMAT,  OPNTAB,  OPENTB 

COMMON/ DE VT YP/ I DE V IC , LSW , LTSW , XYCOOD( 4 ) , LUOUT , LPAGE 
COMMON/GRFTYP/ ANGLE , IRVRSE , CHS IZE(9 ) , ITKWIT , LUDIAG, LUHSET 
C0MM0N/DEVP0S/X1R(5) ,Y1R(5) , X2R( 5) , Y2R(  5 ) 
COMMON/GRFMOD/LFLMAT(5) , LINWDM( 5) , LCLMAT( 5 ) 
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373 

374 

375 

376 

377 

378 

379 

380 

381 

382 

383 

384 

385 

386 

387 

388 

389 

390 

391 

392 

393 

394 

395 

396 

397  C 

398  C 

399  C 

400  C 

401  C 

402  C 

403 

404 

405 

406 

407 

408 

409 

410 

411 

412 

413 

414  C 

415  C 

416  C 

417 

418 

419  C 

420  C 

421  C 

422  C 

423 

424 

425  C 
4 26  C 
427  C 


EQUIVALENCE  ( HWS IZE( 1 ) , CALRAS ) , (HWSIZE( 9 ) , LEXRAS ) 

EQUIVALENCE  (HWSIZE( 13) , TERRAS) 

DATA  START, LINE, SLASH, ENDIT/4B(  , 4H108H,  4H  / , 4H  ) / 

DATA  HBLANR,  HMINUS , HAPOSA,  HAPOSB,  HASTRA,  HASTRB 

1 /4H  , 4H , 4H1  , 4H  1 , 4H*---  , 4H * / 

DATA  OPENANY/.FALSE./ , OPNLEX/ . TRUE, / 

DATA  ITIMET/20/,  IDLETM/50/,  LUDlAG/0/ 

DATA  COUNT/ 5*0/,  NFRAME/5*0/,  ANGLE/0.0/ 

DATA  TERRAS/ 0,0,  1022 , 768/ , LEXRAS/ 50 , 50 , 32700 , 26 1 60/ 

DATA  CALRAS/0,  0,  10750,  7900/ 

DATA  IDFLI0/'L7:  ','PR;  LEX: C NULL: ' / 

DATA  XlR/0,  ,0.  ,l.E+7,0.  ,0./,  X2R/2*1279. , 11279000. ,2*1279./ 
DATA  YlR/0.  ,0.  ,l.E+7,0.  ,0./ , Y2R/2*1023. , 1 1023000.  ,2*1023./ 
DATA  LUSET/7/,  ICODET/ 2 7 , 23/ , ICTRLX/ 3 1 , 24/ 

DATA  ICHANX/27,97, 27, 127/ , OPNCAL/ .TRUE./ 

DATA  NFRAME/5*0/ ,COUNT/5*0/ ,LUHSET/9/ , OPNMAT/ . TRUE . / 

DATA  LFUMAT/0,0, 1,0,0/ , LINWDM/  1,1,2, 1,1/,  LCLMAT/5*!/ 

DATA  MATUNT/8/,  MATFIL/ ' L14: '/ , TABFIL/ ’ L 1 9 : ' / , TABUNT/8/ 

DATA  XYCOOD/1. ,0. ,1. ,0./,  OPNTAB/ . TRUE . / 

DATA  CHSIZE/31.  ,31. ,0.3,0.  5,0.04,0.58,0.  ,0.  ,.03/ 

DATA  USPAT/ 3*3640, 3*455, 3*3 640, 3*455, 0,0, 7 78, 

992,504,240,240,504,992,778,0,0,2*0,Z20,Z70,ZF8, 

Z1FC,Z3FE,Z7FF,4*0, 

0,96,240,504,1020,2046,4095,3999,3855,3591,3075,2049/ 

***  START  OF  THE  SECTION  WHICH  HANDELS  FUNCTIONS 


DEVICE 

IF(OPENANY)  GO  TO  1100 
IDEVIC  = N 
LUOUT  = LUSET 
ITRWIT  = 40 

IF  (IDEVIC.lt. 1. OR. IDEVIC. GT. 5)  IDEVIC  = 4 
CLOSE(LUOUT) 

OPEN(UNIT=LUOUT, IOSTAT=IOS , ERR=90 1 , FILE=IDFLTO( IDEVIC ) , 
1 TYPE='DEVICE' ,SHARE='ERW' , RREY=0 , WREY=0 ) 

OPENANY  = .TRUE. 

IF  (LUDIAG.NE.O)  WRITE  ( LUDIAG, 1003 ) IDEVIC 
RETURN 

ERROR  ON  CALL  TO  DEVICE 
901  CLOSE(LUOUT) 

IF  (LUDIAG.NE.O)  WRITE  ( LUDIAG, 10 14)  IDEVIC,  lOS 

SET  A VALUE  OF  ZERO  IN  THE  DEVICE  TYPE  TO  INDICATE  THAT 
A DEVICE  CAN  NOT  BE  ACCESSED.  ADDED  1/24/85 

IDEVIC  = 0 
RETURN 

SETDEV  - CHANGE  THE  LOGICAL  UNIT 
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428 

429 
4 30 

431 

432 

433  C 

434  C 
4 35  C 
436 
^37 
438 

4 39 

440 

441 

442 

443 

444  C 

445  C 

446  C 
44  7 

448 

449 

450 

451 

452 

453  C 

454  C 

455  C 

456 

457 
4 58 

459 

460 

461  C 

462  C 
4o3  C 

464 

465 

466 

467 

468 

469  C 

470  C 

471  C 

472 

473 

474 

475 

476 

477 

478  C 

479  C 

480  C 

481 

482 


ENTRY  SETDEV  (Nl,  N2) 

IF  (Ni.GT.O)  LUSET  = Nl 
IF  (N2.GE.0)  LUDIAG  = N2 

IF  (LUDIAG. NE.O)  WRITE  (LUDIAG,  1005)  LUOUT,  LUSET 
RETURN 

NEWFRM 

ENTRY  NEWFRM 
MODE?  = i 

IF  ( .NOT.OPENANY)  GO  TO  1000 
COUNT(IDEVIC)  = COUNT(IDEVIC)  + 1 
NFRAME(IDEVIC)  = 1 
IRVRSE  = .FALSE. 

IF  (LUDIAG. NE.O)  WRITE  (LUDIAG,  1101)  COUNT( IDEVIC) 

GO  TO  (1,2, 3, 4, 5),  IDEVIC 

FRAME  - FORCE  A WRITE  OF  THE  BUFFER 

ENTRY  FRAME 
MODE?  = 2 

IF  (.NOT.OPENANY)  GO  TO  1000 
NFRAM£( IDEVIC)  = NFRAME( IDEVIC ) + 1 

IF  (LUDIAG. NE.O)  WRITE  (LUDIAG,  1001)  NFRAME( IDEVIC) , IDEVIC 
GO  TO  (1,2, 3, 4, 5),  IDEVIC 

ERASE 

ENTRY  ERASE 
MODEP  = 3 

IF  (.NOT.OPENANY)  GO  TO  1000 

IF  (LUDIAG. NE.O)  WRITE  ( LUDIAG, 1 50 1 ) NFRAME( IDEVIC) 

GO  TO  (1,2, 3, 4, 5),  IDEVIC 

HARD  COPY 

ENTRY  HDCOPY 
MODEP  = 4 

IF  (.NOT.OPENANY)  GO  TO  1000 

IF  (LUDIAG. NE.O)  WRITE  (LUDIAG, 1502)  NFRAME( IDEVIC) 

GO  TO  (1,2, 3, 4, 5),  IDEVIC 

COLOR 

ENTRY  COLOR  (N) 

MODEP  = 5 

IF (.NOT.OPENANY)  GO  TO  1000 
ICO LOR  = N 

IF  (LUDIAG. NE.O)  WRITE  (LUDIAG,  1214)  ICOLOR 
GO  TO  (1,2, 3, 4, 5),  IDEVIC 

SET  THE  TYPE  FOR  POLYGON  AND  CIRCLE  FILLING  0,  1,  2,  OR  3 

ENTRY  FILTYP(IFIL) 

IF( .NOT.OPENANY)  GO  TO  1000 
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483 

484 

485 

486 

487  C 

488  C 

489  C 

490 

491 

492 

493 

494 

495 

496 

497 

498 

499  C 

500  C 

501  C 

502 

503 

504 

505 

506 

507 

508  C 

509  C 

510  C 

511 

512 

513 

514 

515 

516 

517 

518 

519 

520 

521 

522 

523 

524 

525 

526 

527 

528 

529 

530 

531 

532 

533 

534 

535 

536 

537 


LFLMAT(IDEVIC)  = IFIL 

IF(LUDIAG.GT.O)  WRITE(LUDIAG, 1503)  LFLMAT 
MODE?  = 5 

GO  TO  (1,2, 3, 4, 5),  IDEVIC 

SET  THE  SIZE  OF  THE  HARDWARE  CHARACTERS 

ENTRY  CHRSIZ  (CHFRZ,  GCHFRZ) 

IF(  .NOT.OPENAxNY)  GO  TO  1000 

IF(  CHFRZ.  GT.O)  CHSIZE(9)  = CHFRZ 

CHSIZE(l)  = CHSIZE(9)  * (Y2R( IDEVIC)-Y 1R( IDEVIC) ) 

CHSIZE(2)  = CHSIZE(l) 

IF  (GCHFRZ.  GT.O)  CHSIZE(5)  = GCHFRZ 
IF(LUDIAG.GT.O)  WRITE(LUDIAG,  1505)  CHFRZ,  GCHFRZ 
MODE?  = 5 
RETURN 

SET  THE  LINE  WIDTH 

ENTRY  LINWID(LINWD) 

IF( .NOT.OPENANY)  GO  TO  1000 
LINWDM( IDEVIC)  = MAXO(LINWD , 1 ) 

IF(LUDIAG.GT.O)  WRITE(LUDIAG, 1 504)  LINWDM 
MODEP  = 5 

GO  TO  (1,2, 3, 4, 5),  IDEVIC 
SCALE 

ENTRY  SCALNG(X1,Y1,X2,Y2,X1H,Y1H,X2H,Y2H,X1S,Y1S,X2S  ,Y2S) 
IF( .NOT.OPENANY)  GO  TO  1000 
IND  = (IDEVIC-1)*4 
IF(IDEVIC.EQ. 1)  THEN 
SCLRAS  = 1000. 

ELSE 

SCLRAS  = 1. 

ENDIF 


IF 

(XlH.GE.0.0) 

HWSIZE(IND+1) 

= XIH 

* 

SCLRAS 

IF 

(YlH.GT.0.0) 

HWSIZE(IND+2) 

= YIH 

* 

SCLRAS 

IF 

(X2H.GE.0.0) 

HWSIZE(IND+3) 

= X2H 

* 

SCLRAS 

IF 

(Y2H.GT.0.0) 

HWSIZE(IND-l-4) 

= Y2H 

* 

SCLRAS 

IF 

(XlS.NE.0.0) 

XIR(IDEVIC)  = 

XIS 

IF 

(X2S.NE.0.0) 

X2R(IDEVIC)  = 

X2S 

IF 

(YlS.NE.0.0) 

YIR(IDEVIC)  = 

YIS 

IF 

(Y2S.NE.0.0) 

Y2R(IDEVIC)  = 

Y2S 

GO  TO  11 

ENTRY  DEFINE  (XI,  Yl,  X2,  Y2) 

11  MODEP  = 6 

IF( .NOT.OPENANY)  GO  TO  1000 
DX  = X2  - XI 
IF  (DX.EQ.0.0)  DX  = 1.0 

XYCOOD(l)  = (X2R(IDEVIG)  - X1R( IDEVIC) )/DX 
XYCOOD(2)  = XIR(IDEVIC)  - XYCOOD(l)*Xl 
DY  = Y2  - Yl 
IF  (DY.EQ.0.0)  DY  = 1.0 

XYCOOD(3)  = (Y2R(IDEVIC)  - Y 1R( I DEV IC ) ) / DY 
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XYC00D(4)  = YIR(IDEVIC)  - XYCOOD(3)*Yl 
IF  (LUDIAG.NE.O)  WRITE  (LUDIAG,  1400)  XYCOOD 
CHSIZE(l)  = CHSIZE(9)  * (Y2R(IDEVIC)-Y1R(IDEVIC) ) 

CHSIZE(2)  = CHSIZE(l) 

GO  TO  (1,2, 3, 4, 5),  IDE VIC 
C 

C ENDFRM  - TO  CLOSE  THE  LOGICAL  UNIT 

C 

ENTRY  ENDFRM 

IF( .NOT.OPENANY)  GO  TO  1000 
MODE?  = 7 

IF  (LUDIAG.NE.O)  WRITE  (LUDIAG, 1201 ) COUNT( IDEVIC) , 
NFRAME(IDEVIC) 

NFRAME( IDEVIC)  = 0 
GO  TO  (1,2, 3, 4, 5),  IDEVIC 
10  CLOSE(7) 

OPENANY  = .FALSE. 

IDEVIC  = 0 
RETURN 
C 

C ***  START  OF  THE  SECTION  WHICH  HANDELS  THE  HARDWARE  *** 

C 

C 

C CALCOMP  SECTION 

C 

1 GO  TO  (101,102,103,103,105,106,107),  MODEP 

C 

C CALCOMP  LNITIALIZATION 

C 

101  CALL  CALBUF  ( LUOUT , 0 , 1 , IDXX) 

IF(OPNCAL)  CALL  CALPLT  (0.0,  +1.0,  1007) 

OPNCAL  = .FALSE. 

CALL  CALPLT  ( FLOAT(CALRAS( 3 ) ) / ( (X2R( 1 )-XlR( 1 ) )*i000. ) , 
FLOAT(CALRAS(4))/((Y2R(1)-Y1R(1))*1000. ) , 1001) 

CALL  CALPEN  (1) 

LSW  = .TRUE. 

RETURN 

C 

C CALCOMP  FRAME  (FLUSH  BUFFER  AND  RESET,  IGNORE  HARDCOPY) 

C 

102  RETURN 
C 

C ERASE  THE  SCREEN  AND  PRINT  HARDCOPY  ARE  IGNORED  FOR  THE  CALCOMP 

C 

103  RETURN 
C 

C COLOR  SELECTION  PRINTOUT. 

C 

105  PEN  = MOD(ICOLOR-l,4)  + 1 
PEN  = MIN0(MAX0(PEN, 1) ,4) 

LCLMAT( IDEVIC)  = PEN 
CALL  CALPEN(PEN) 

RETURN 

C 

C CALCOMP  AXIS  SET. 
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593 

594 

595 

596 

597 
5 98 

599 

600 
601 
602 

603 

604 


C 


c 

c 

c 


c 


106  CONTINUE 

CALL  CALPLT  ( FLOAT( CALRAS( 3 ) ) / ( (X2R( 1 ) -X1R( 1 ) ) *1 000. ) , 
FL0AT(CALRAS(4))/((Y2R(1)-Y1R(1))*1000.),  1001) 

RETURN 

ENDFRM  FOR  CALCOMP 


107  CONTINUE 

CALL  CALPLT(0. , 0. , 999) 
GO  TO  10 


605 

606 

607 

608 

609 

610 
611 
612 

613 

614 

615 

616 

617 

618 


C 

C 

C 

C 

C 

C 

C 


201 

203 

211 


PAPER  PLOT  SECTION 

GO  TO  (201,202,203,204,205,206,207),  MODEP 
PAPER  PLOT  INITIALIZATION. 

THE  PAGE  PLOT  IS  OUTPUT  AS  ONE  LARGE  VARIABLE  FORMAT, 
SET  UP  THE  FORMAT  STATEMENT  IN  LPAGE. 

CONT INUE 
DO  211  J=l,65 
LPAGE(2, J)=LINE 
LPAGE(30, J)=SLASH 
LPAGE(1, 1)=START 
LPAGE(30,65)=ENDIT 


619 

C 

620 

C 

SET  UP  THE  PAGE  AND  CLEAN 

621 

C 

622 

DO  221  J = 1,  65 

623 

DO  221  I = 4,  29 

624 

221 

LPAGE(I,J)  = HBLANK 

625 

DO  222  I = 5,  28 

626 

LPAGE(I, 1)  = HMINUS 

627 

222 

LPAGE(I,63)  = HMINUS 

628 

DO  223  J = 2,  62 

629 

LPAGE ( 4, J)  = HAPOSA 

630 

223 

LPAGE(29,J)  = HAPOSB 

631 

LPAGE (29,1)  = HASTRB 

632 

LPAGE(29,63)  = HASTRB 

633 

LPAGE (4, 63)  = HASTRA 

634 

LPAGE(4,  1)  = HASTRA 

635 

RETURN 

636 

C 

637 

C 

PAPER  PLOT-  WRITE  OUT  THE 

638 

C 

639 

202 

WRITE(LUOUT,  LPAGE) 

640 

RETURN 

641 

C 

642 

C 

HARDCOPY  COMMAND 

643 

C 

644 

204 

RETURN 

645 

C 

646 

C 

COLOR  SELECTION  PRINTOUT. 

647 

C 
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205  RETURN 
C 

C SET  SCALING  FOR  PAGE  PLOT 
C 

206  RETURN 
C 

C ENDFRM  FOR  THE  PAPER  PLOTTER 

C 

207  WRITE  (LUOUT,1212) 

GO  TO  10  . 

C 

C LE XI DATA/ MATRIX  SECTION 

C 

3 GO  TO  (301,302,303,304,305,306,307),  MODEP  . 

C 

C INITIALIZE  THE  LE XI DATA/ MATRIX  - OPEN  AND  SET  THE  LUT  ONLY 

C IF  THE  DEVICE  IS/WAS  CLOSED 

C 


301  IF(OPNLEX)  THEN 

CALL  GSOPN(LUOUT,  1,  LIERR) 

IF(LIERR.NE.O)  GO  TO  1002 
C 

C CURSOR  OFFSET  - THIS  IS  INSTALLATION  SPECIFIC 
C 


C 

C 

C 


3001 


CALL  DSCSLdO,  153,  75) 

CALL  DSCER 

CALL  SETLUT  ; SET  THE  DEFAULT  LOOK  UP  TABLE 
CALL  GSTYPE(3) 

SET  VIEW  CORRESPONDENCE 

CALL  GDEFVS  (1,  15,  0,  1,  4,  0) 

CALL  GINTVS  (1) 

CALL  GACTVS  (1) 

CALL  GDFWIN  (1,  XIR(IDEVIC),  YIR(IDEVIC),  X2R(IDEVIC), 
Y2R(IDEVIC) ) 

CALL  GDFVP  (1,  LEXRAS(l),  LEXRAS(2),  LEXRAS(3),  LEXRAS(4)) 
VSNUM(l)  = 2 
VSNUM(2)  = 0 

CALL  GDFVU  (1,  1,  1,  VSNUM) 

CALL  GACTVU(l) 

CALL  GDASEG 
CALL  GCRSEG(IOO) 

DO  3001  I = 1,  4 

CALL  GDPAT(100+I,  USPAT(1,I)) 


CALL  GCLSEG 

CALL  GSVUAS(100,  VSNUM) 

CALL  GDLSEG(IOO) 

CALL  GSIVIS(l) 

CALL  GSVUAS  (0,  VSNUM) 

C 

C DEFINE  LOCATOR  PORT  EXTENTS  AND  SET  TRACKING  TYPE 
C 


CALL  GDVINI(DEVID,  2,  1) 

CALL  GDFLPT(DEVID,  LEXRAS( 1 ) , LEXRAS( 2 ) , LEXRAS ( 3 ) , LEXRAS (4 ) ) 
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703 

CALL  GSTTRK(DEVID,  2,  1) 

704 

C 

705 

C 

SET  ECHO  TYPE 

7 06 

C 

707 

CALL  GSTDVE(DEVID,  1,  1) 

708 

CALL  GDVENB(DEVID) 

709 

CALL  GRSLG  (DEVID,  255) 

710 

OPNLEX  = .FALSE. 

711 

ENDIF 

712 

C 

713 

c 

SET  THE  PARAMETERS  FOR  THE  LEXIDATA  DISPLAY, 

714 

c 

715 

CALL  GCLSEG 

716 

CALL  DSCLR(-l) 

717 

CALL  GCTSEG 

718 

CALL  GSFTYP(LFLMAT(IDEVIC)) 

719 

CALL  GSLWID(LINWDM(IDEVIC)) 

7 20 

CALL  GSCHSZ(CHSIZE(2)) 

721 

CALL  GSCNDX  (1) 

722 

RETURN 

723 

c 

724 

c 

FRAME  - FORCE  OUT  THE  CONTENTS  OF  THE  BUFFER 

725 

c 

726 

302 

CALL  GCLSEG 

727 

CALL  GMPCUR 

728 

CALL  GCTSEG 

729 

RETURN 

7 30 

c 

731 

c 

ERASE  THE  SCREEN  AND  THE  CURSOR 

732 

c 

733 

303 

CALL  DSCLR(-l) 

7 34 

CALL  DSCSL  (10,  153,  75) 

735 

RETURN 

7 36 

c 

737 

c 

HARD  COPY  - CAMERA 

7 38 

c 

739 

304 

IF(OPNMAT)  THEN 

740 

CLOSE (MATUNT) 

741 

OPNTAB  = .TRUE. 

742 

OPEN(UNIT=MATUNT  , IOSTAT=IOS  , ERR=3  14  , FILE=I 

743 

• 

TYPE='DEVICE' ,SHARE='ERW , RKEY=0 , WK£Y=0 ) 

744 

OPNMAT  = .FALSE. 

745 

ENDIF 

746 

IF(LUDIAG.NE.O)  WRITE(LUDIAG, 1003)  MATUNT 

747 

CALL  SYSIO(PBLK, 41, MATUNT, ' .CE. ' ,4,0) 

748 

CALL  WAIT(ITIMET,2,IOS) 

749 

RETURN 

7 50 

c 

751 

c 

ERROR  ON  CALL  TO  DEVICE 

752 

c 

753 

314 

CLOSE (MATUNT) 

7 54 

IF  (LUDLAG.NE.O)  WRITE  (LUDIAG, 1014)  MATUNT 

755 

STOP  'camera  can  not  be  accessed' 

756 

c 

757 

c 

SET  COLOR  - THIS  APPLIES  TO  WHAT  IS  IN  THE  LUT 
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C 

305  LEXCOL  = MOD(  ICOLOR-1 , 1 5)  + 1 
LEXCOL  = MAX0(  LEXCOL,  1) 

LCLMAT(IDEVIC)  = LEXCOL 

CALL  GSCNDX(LCLMAT(IDEVIC)) 

CALL  GSLWID(LINWDM(IDEVIC)) 

LFLLEX  = LFLHAT(IDEVIC) 

IF(LFLLEX.LE.4)  THEN 
CALL  GSFTYP(LFLLEX) 

ELSE 

CALL  GSFTYP(96+LFLLEX) 

ENDIF 

RETURN 

C 

C SET  THE  WINDOW  AND  AREA  OF  NORMALIZED  DEVICE  COORDINATES 
C 

306  IF(OPNLEX)  GO  TO  301 
CALL  GCLSEG 

CALL  GDAVU(l) 

CALL  GDFWIN  (1,  XIR(IDEVIC),  YIR(IDEVIC),  X2R(IDEVIC), 
Y2R(IDEVIC)) 

CALL  GDFVP  (1,  LEXRAS(l),  LEXRAS(2),  LEXRAS(3),  LEXRAS(4)) 
CALL  GDFVU  (1,  1,  1,  VSNUM) 

CALL  GACTVU  O) 

C 

C OPEN  A NEW  SEGMENT 
C 

CALL  GCTSEG 
RETURN 
C 
C 

307  OPNLEX  = .TRUE. 

IF  ( .NOT.OPNMAT)  THEN 
CLOSE (MATUNT) 

OPNMAT  = .TRUE. 

ENDIF 

CALL  GCLSEG 
CALL  GDASEG 
CALL  GFRAME 
CALL  DSCLR(-l) 

CALL  GRSLG(DEVID,255) 

CALL  GDVDSB(DEVID) 

GO  TO  10 
C 

C TEKTRONIX  SECTION 

C 

4 GO  TO  (401,402,403,404,405,406,407),  MODEP  ' 

C 

C TEKTRONIX  INITIALIZATION 

C 

401  CALL  TEKINT  (120) 

CALL  SWINDO  (TEKRAS ( 1 ) , TEKRAS( 3) ,TEKRAS ( 2 ) ,TEKRAS( 4 ) ) 

CALL  VWINDO  (X1R( IDEVIC) , X2R(IDEVIC)-X1R(IDEVIC) , 
YIR(IDEVIC),  Y2R(IDEVIC)-Y1R(IDEVIC)) 

LTSW  = .TRUE. 
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CALL  TEKHOM 
CALL  TTKSND 

CALL  WAIT  (IDLETM,  1,  IS) 

RETURN 

C 

C FRAME  (NO  MODE  SWITCHING) 

C 

402  CONTINUE 
CALL  TTKSND 

CALL  WAIT  (IDLETM,  1,  IS) 

RETURN 

C 

C ERASE  THE  SCREEN 

C 

403  CONTINUE 
CALL  TEKHOM 
CALL  TEKERA 

CALL  TOUTST  (2,  ICTRLX) 

CALL  TTKSND 

CALL  WAIT  (IDLETM,  1,  IS) 

RETURN 

C 

C ISSUE  HARD  COPY  COMMAND 

C 

404  CONTINUE 

CALL  TOUTST  (2,  ICODET) 

CALL  TEKHOM 
CALL  TTKSND 

CALL  WAIT  (ITIMET,  2,  IS) 

RETURN 

C 

C COLOR  - DOES  NOT  APPLY  TO  ADM  OR  TEKTRONIX  4054 
C 

405  CONTINUE 
RETURN 

C 

C SET  SCREEN  CORRESPONDENCE 
C 

406  CONTINUE 

CALL  SWINDO(TEKRAS(l) ,TEKRAS(3) ,TEKRAS(2) ,TEKRAS(4)) 
CALL  VWINDO  (X1R( IDEVIC) , X2R( I DEVIC )-XlR( I DE VIC ) , 
YIR(IDEVIC),  Y2R(IDEVIC)-Y1R(IDEVIC) ) 

RETURN 

C 

C END  THE  FRAME  ON  THE  ADM  OR  TEK  4054 
C 

407  CALL  TEKHOM 

CALL  TOUTST  (2,  ICTRLX) 

CALL  TTKSND 

CALL  WAIT  (IDLETM,  1,  IS) 

CALL  SVSTAT  (SCRATCH) 

GO  TO  10 
C 

C SLOT  FOR  AN  EXTRA  DEVICE 

C 
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5 STOP  74 
C 

C DELAY  IN  SECONDS  FOR  HARD  COPY  UNITS 

C 

ENTRY  DELAY(ITIME) 

ITIMET  = ITLME 
RETURN 
C 

C IOWA  IT 

C 

ENTRY  lOWAIT(IT) 

CALL  WAIT  (IT,  1,  IS) 

RETURN 

C 

C GET  THE  DEVICE  ID  FOR  THE  LEXIDATA  TRACKING  TYPE 
C 

ENTRY  LEXDID(IDVL) 

IDVL  = DEVID 
RETURN 
C 

C OPEN  ACCESS  TO  THE  TABLET  - IF  POSSIBLE 
C 

ENTRY  TABLET  (OPENTB) 

OPENTB  = .FALSE. 

IF(OPNTAB)  THEN 

IF(.NOT.OPNMAT)  CLOS E(MATUNT) 

OPEN(UNIT=TABUNT , IOSTAT=IOS , ERR=1 304 , FILE=TABFIL, 

TYPE= 'DEVICE ' ,SHARE='ERW' ,RKEY=0, 
WKEY=0) 

OPNTAB  = .FALSE. 

OPENTB  = .TRUE. 

OPNMAT  = .TRUE. 

ELSE 

IF(LUDIAG.GT.O)  WRITE( LUDIAG, 1302) 

OPENTB  = .TRUE. 

END  IF 
RETURN 
C 

C THE  TABLET  HAS  GENERATED  AN  ERROR 
C 

1304  CLOSE(TABUNT) 

IF ( LUDIAG. GT.O)  WRITE(LUDIAG, 1303)  TABUNT,IOS 
STOP  'can  not  access  tablet' 

C 

C PUNISH  IF  NOT  INITIALIZED. 

G 

1000  IF  (LUDIAG. NE.O)  WRITE  (LUDIAG,  1004)  MODEP,  IDEVIC 
IDEVIC  = 0 
RETURN 

1002  IF  (LUDIAG. NE.O)  WRITE(LUDIAG,  1013)LIERR 

STOP  'Lexidata  can  not  be  accessed' 

1100  IF  (LUDIAG. NE.O)  WRITE( LUDIAG,  1006)  IDEVIC 

RETURN 
C 

C FORMATS 
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923 

C 

924 

1001 

FORMAT  ( 

' FRAMES  PLOTTED  = ',15,'  ON  DEVICE  ',13 

925 

1003 

FORMAT  ( 

' DEVICE  = ',12,'  INITIALIZED') 

926 

1004 

FORMAT  ('  DEVICE  NOT  INITIALIZED.  215) 

927 

1005 

FORMAT  ( 

' LUOUT  = ',13,'  AND  WILL  BE  SET  TO  ',13, 

928 

• 

' AT  TEE 

NEXT  CALL  TO  "DEVICE"') 

929 

1006 

FORMAT  ( 

' DEVICE  ',13,'  IS  ALREADY  OPEN') 

930 

1013 

FORMAT  ( 

' CAN  NOT  OPEN  LEXIDATA,  ERROR  =',I3) 

931 

1014 

FORMAT  ( ' 

DEVICE  ',13,'  CAN  NOT  BE  ACESSED,  ERROR 

932 

1101 

FORMAT  ( ' 

FRAME  NUMBER  ',15,'  INITIALIZED') 

933 

1201 

FORMAT  ( ’ 

PLOTTER  CLOSED  WITH' ,215, ' FRAMES') 

934 

1212 

FORMAT  ( ' 

1') 

935 

1214 

FORMAT  ( ' 

COLOR  SELECT  = ',13) 

936 

1302 

FORMAT ( ' CAMERA  IS  ALREADY  AVAILABLE') 

937 

1303 

FORMAT  ( ' 

CAMERA  ',13,'  CAN  NOT  BE  ACESSED,  ERROR 

938 

1400 

FORMAT  ( ' 

FACTOR  ',4F8.2) 

939 

1501 

FORMAT  ( ' 

ERASE  COMMAND  ISSUED  AT  FRAME  ',15) 

940 

1502 

FORMAT  ( ' 

HARDCOPY  COMMAND  ISSUED  AT  FRAME  ',15) 

941 

1503 

FORMAT  ( ' 

SET  THE  FILL  TYPE  FOR  SURFACES  ',513) 

942 

1504 

FORMAT  ( ' 

SET  THE  LINE  WIDTH  ',513) 

943 

1505 

FORMAT  ( ' : 

SET  THE  CHARACTER  SIZE  (%)  ',2F6.3) 

944 

END 

M3) 


,13) 
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945 

946 

947 

948 

949 
9 50 

951 

952 

953 

954  C 

955  C 
95b  C 

957 

958 

959 

960 

961 

962 

963 

964 

965 

966 

967  C 

968  C 

969  C 

970 

971 

972 

973 
9 74 

975 

976  C 

977  C 

978  C 

979 

980  C 

981  C 

982  C 

983 

984 

985 

986 

987 

988 

989 

990 

991 

992 

993  C 

994  C 

995  C 

996 

997 
9 98 
999 


SUBROUTINE  DEVINP( INPUT , BTMASK, IDV, X,Y, Z) 

LOGICAJ.  JFIRST/.TRUE./ , TFIRST/ . TRUE.  / , KFIRST/ . TRUE . / 
INTEGER  BTMASK,DEVID,PBLK(6) ,TLOOK(4)/l,2,4,8/ 
CHARACTER*!  INST( 2 ) /Z IB , ' A 7 
CHARACTER*20  DATAIN 

COMMON/ DEVT YP/ IDEVIC , LSW , LTSW , XYCOOD( 4 ) , LUOUT , LPAGE 
COMMON/ TXXDAT/ TAB IN , TABWIN , TAB XYC 
REAL  TABIN(2) ,TABWIN(4) ,TABXYC(4) 

C0MM0N/DEVP0S/X1R(5) ,Y1R(5) ,X2R(5) , Y2R(5) 

SELECT  THE  INPUT  FROM  THE  DEVICE  CODE 

X = 0. 

Y = 0. 

Z = 0. 

IDV  = 0 

IF( INPUT.lt. 1.0R.INPUT.GT.3)  RETURN 
IF(INPUT.NE.  l.AND.  (.NOT.JFIRST))  THEN 
CALL  DSCSL  (10,  153,  75) 

JFIRST  = .TRUE. 

ENDIF 

GO  TO  (10,  20,  30),  INPUT 

GET  THE  DEVICE  ID  FOR  THE  JOYSTICK 

10  IF(JFIRST)  THEN 

CALL  LEXDID(DEVID) 

CALL  GDFBGF(DEVID,  15,  0,  IDUM) 

CALL  DSCSL  (8,  153,  75) 

JFIRST  = .FALSE. 

ENDIF 

SET  APPROPRIATE  LIGHTS 

CALL  GSLTG(DEVID, BTMASK) 

READ  THE  LOCATOR 

XWC  = 0,0 
YWC  = 0.0 

3 CALL  GRBTG(DEVID,  IDV) 

IDV  = IAND(IAND( IDV, BTMASK), 15) 

IF(IDV.EQ. 0)  GO  TO  3 ; NO  SWITCH  HAS  BEEN  TOGGLED 
CALL  GSLC(DEVID,  IDVV,  LCX,  LCY,  XWC,  YWC) 

IF(LCX.LT.O)  GO  TO  3 
CALL  GRSLG  (DEVID,  255) 

2 CALL  GRBTG  (DEVID,  IDVV) 

IF(IDVV.NE.O)  GO  TO  2 

NORMALIZE  TO  <RE>WINDOWED  COORDINATES 

X = (XWC-XYCOOD(2))  / XYCOOD( 1 ) 

Y = (YWC-XYCOOD(4))  / XYGOOD(3) 

Z = 0.0 

RETURN 
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1002 
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1006 

1007 

1008 
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1011 
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1016 

1017 

1018 

1019 

1020 

1021 
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1026 

1027 

1028 

1029 
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1034 

1035 
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C 

C THE  TABLET  HAS  BEEN  SELECTED 
C 

20  IF(TFIRST)  THEN 

TFIRST  = .FALSE. 

CALL  TABLET(OPENTB) 

IF(IDEVIC.EQ.O)  THEN 
DX  = 1280. 

DY  = 1024. 

ELSE 

DX  = (X2R(IDEVIG)-X1R(IDEVIC))  / XYCOOD(l) 
DY  = (Y2R(IDEVIC)-Y1R(IDEVIC))  / XYCOOD(3) 
ENDIF 

TABXYC(l)  = 8.2034E-5  * DX 
TABXYC(2)  =0.0 
TABXYC(3)  = 1.0938E-4  * DY 
TABXYC(4)  =0.0 
ENDIF 

21  CALL  SYSIO(PBLK,72,8,DATAIN,20,0) 

READ(DATAIN, 22,ERR=21)  IX,IY,IBT 

22  F0RMAT(1X,I5,2X,I5, 1X,I2) 

IF(IBT.EQ.O)  GO  TO  21 

C 

C CONVERT  THE  CURSOR  BUTTON  TO  A STANDARD  FORMAT 
C 

IDV  = TLOOK(IBT) 

IDV  = IAND(BTMASK,  IDV) 

IF(IDV.EQ.O)  GO  TO  21 
TABIN(l)  = IX 
TABIN(2)  = lY 

X = FLOAT(IX)*TABXYC( 1)  + TABXYC(2) 

Y = FLOAT(IY)*TABXYC(3)  + TABXYC(4) 

Z = 0.0 

RETURN 

C 

G INPUT  FROM  THE  KEYBOARD 
C 

30  CALL  SYSIO  ( PBLK, 4 1 , 5 , ' X, Y , Z , IDV  = ',12,0) 
READ(5,32,END=33,ERR=30)  XCOR,YCOR,ZCOR, IDV 

32  FORMAT(3F,I) 

X = XCOR 

Y = YCOR 

Z = ZCOR 

IDV  = IAND(BTMASK, IDV) 

RETURN 

33  IDV  = BTMASK 
RETURN 

END 
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SUBROUTINE  ENUMBR  (REALNO,  XRl,  YRl,  XR2 , YR2) 

C 

Q************A********************************************************** 

C ENUMBR 

(^*********************************************************************** 

C 

DX  = (XR2  - XR1)/10.0 
THE  NO  = REALNO 
EXPON  = 0.001 

IF  (REALNO  .EQ.  0.0)  GO  TO  10 
12  IF  (ABS(THENO)  .LT.  10.0)  GO  TO  11 

EXPON  = EXPON  + 1.0 
THENO  = THENO*0. 1000001 
GO  TO  12 

11  IF  (ABS(THENO)  .GE.  1.0)  GO  TO  10 

EXPON  = EXPON  - 1.0 
THENO  = THENO*9. 99999 
GO  TO  11 

10  CALL  FNUMBR  (XRl,  YRl,  DX,  0.0,  0. 7*DX,  0.0,  YR2-YR1, 

1 THENO,  5,  2) 

CALL  WDDRAW  (XR1+5.0*DX,  YRl,  DX,  0.0,  0.7*DX,  0.0, 

1 YR2-YR1,  '*101.') 

CALL  FNUMBR  (XR1+8.0*DX,  ( YR1+YR2) /2. 0 , 0.66*DX,  0.0, 

1 0.75*DX,  0.0,  0.64*(YR2-YR1) , EXPON,  3,  0) 

C 1 0.50*DX,  0.0,  0.6*(YR2-YR1) , EXPON,  3,  0) 

RETURN 

END 
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1075 

1076 

1077 

1078 

1079 

1080 

1081 

1082 

1083 

1084 

1085 
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1087 

1088 

1089 

1090 

1091 

1092 

1093 
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1095 

1096 

1097 

1098 

1099 

1100 

1101 
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1 103 

1104 
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1 107 

1 108 

1 109 

1110 

nil 

1 112 

1113 
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1116 
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1118 
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SUBROUTINE  FNUMBR  (XSTART,  YSTART,  DX,  DY,  SX,  SXY,  SY, 


1 NUMBR,  WIDTH, 
C 


c 

X 

REAL 

c 

c 

Y 

REAL 

c 

c 

DX 

REAL 

c 

c 

DY 

REAL 

c 

c 

SX 

REAL 

c 

SXY 

REAL 

c 

SY 

REAL 

c 

RNUMB 

REAL 

c 

WIDTH 

INTEGER 

c 

DIGITS 

INTEGER 

C 


DIGITS) 

X COORDINATE  (MATHEMATICAL  SPACE)  OF  THE  FIRST 
CHARACTER  TO  BE  DRAWN 

Y COORDINATE  (MATHEMATICAL  SPACE)  OF  THE  FIRST 
CHARACTER  TO  BE  DRAWN 

INCREMENT  TO  BE  ADDED  TO  THE  X COORDINATE  FOR 
EACH  CHARACTER  DRAWN 

INCREMENT  TO  BE  ADDED  TO  THE  Y COORDINATE  FOR 
EACH  CHARACTER  DRAWN 
X MATH  SPACE  SIZE  FOR  CHARACTERS 
SIANT  MODIFIER  FOR  CHARACTERS 

Y MATH  SPACE  SIZE  FOR  CHARACTERS 
NUMBER  TO  BE  PLOTTED  IN  F FORMAT 

TOTAL  WIDTH  OF  FIELD  INCLUDING  DECLMAL  POINT 
NUMBER  TO  FRACTIONAL  PLACES  TO  BE  DRAWN 


REAL  NUMBER,  NUMBR,  TEST(6) 

INTEGER  WIDTH,  DIGITS,  NL’M,  NN(22) 

LOGICAL  SPACE 

INTEGER  WORD(7),  HASTR,  HTEMP,  SFIL(3) 

INTEGER  TEXT(13) 

CHARACTER*!  WWORD(28),  BLANK,  HMINUS 

DATA  TEXT  /Z00000030,  Z00000031,  Z00000032,  Z00000033, 

1 Z00000034,  Z00000035,  Z00000036,  Z00000037, 

2 Z00000038,  Z00000039,  Z00000020,  Z0000002E, 

3 Z0000007C  / 

DATA  SFIL  / '*1..',  ’**1.’,  '***V  / 

DATA  HMINUS,  HASTR  / ’-  ',  '****’  /,  BLANK/'  '/ 

EQUIVALENCE  (WORD(  1 ) ,TEST(  1 ) ,WWORD(  1 ) ) 


11  = 1 

12  = 1 

NUMBER  = ABS(NUMBR) 

IF  (DIGITS. EQ.O)  NUM  = NUMBER  +0.5 
IF  (DIGITS. EQ.O)  GO  TO  5 
C 

WIDTH  = WIDTH  - 1 
NUM  = NUMBER*10**DIGITS  +0.5 
5 DO  10  I = 1, WIDTH 

J = WIDTH  - I + 1 
NN(J)  = NUM  - 10*(NUM/10) 

C 

C BREAK  OUT  THE  DIGITS. 

C 


NUM  = NUM/10 
10  CONTINUE 

J = WIDTH  - DIGITS 
IF(J  .NE.  0)  GO  TO  18 
WORD(l)  = TEXT(ll) 

II  = II  + 1 
GO  TO  25 

18  SPACE  = .TRUE. 

DO  20  K = 1,J 


-165- 


1130 

I 131 

1 132 

1133 

1134 

1135 

1136 

1137 

1 138 

1 139 

1 140 

1 141 

1 142 

i 143 

1 144 

1 145 

1 146 

1 147 

1 148 

1 149 

1 150 

1 151 

1 152 

1 153 

1 154 

1155 

1 156 

1157 

1 158 

1 159 

1 160 

1 161 

1 162 

1163 

1164 

1 165 

1 166 

1167 

1168 

1 169 

1 170 

1 171 

1172 

1 173 

1174 

1175 

1176 

1177 

1178 

1179 

1 180 

1181 

1182 

1 183 

1184 
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I = NN(K) 

C 

C LEADING  ZERO  = SPACE 
C 

IF  (I.NE.O)  SPACE  = .FALSE. 

IF(K  .EQ.  J .AND.  SPACE)  SPACE  = .FALSE. 
IF  (I.EQ.O.  AND.  SPACE)  I = 10 

II  = II  + 1 

HTEMP  = ISliFT(W0RD(I2)  , 8) 

W0RD(I2)  = IOR(HTEMP, TEXT (1+1)) 

IF(I1  .LT.  5)  GO  TO  20 
12  = 12  + 1 

11  = 1 

20  CONTINUE 

IF  (DIGITS. EQ.O)  GO  TO  40 
C 

C PUT  IN  DECIMAL  POINT 

C 

25  II  = II  + 1 

HTEMP  = ISHFT(W0RD(I2) , 8) 

W0RD(I2)  = lOR ( HTEMP, TEXT( 12)) 

IF(I1  .LT.  5)  GO  TO  26 

12  = 12  + 1 
II  = 1 

26  DO  30  K = 1, DIGITS 

I = NN(J+K) 

II  = II  + 1 

HTEMP  = ISHFT(W0RD(I2),  8) 

W0RD(I2)  = I0R(HTEMP,TEXT(I+1) ) 

IF(I1  .LT.  5)  GO  TO  30 
12  = 12  + 1 

11  = 1 

30  CONTINUE 

WIDTH  = WIDTH  + 1 
C 

C PUT  IN  (END  OF  TEXT) 

C 

40  II  = II  + 1 

HTEMP  = ISHFT(WORD(I2) , 8) 

WORD(I2)  = IOR(HTEMP,TEXT(13)) 

IF(I1  .LT.  5)  GO  TO  42 

12  = 12  + 1 
II  = 1 

42  HTEMP  = ISHFT(WORD(I2) , 8) 

WORD(I2)  = IOR(HTEMP,TEXT(12)) 

C 

C LEFT  JUSTIFY  LAST  WORD. 

C 

44  II  = II  + 1 

IF(I1  .GE.  5)  GO  TO  46 
WORD(I2)  = ISHFT(WORD(I2) , 8) 

GO  TO  44 
C 

C PUT  IN  THE  MINUS  SIGN 
C 
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1 185 

46 

IF  (NUMBR  .GE,  0.0)  GO  TO  50 

1186 

IF (WWORD(l).NE. BLANK)  GO  TO  60 

1187 

NUMMX  = 4 * 12 

1 188 

DO  47  I = 2,  NUKMX 

1 189 

IP  = I 

1 190 

IF(WWORJ)(I).NE.  BLANK)  GO  TO  48 

1 191 

47 

CONTINUE 

1192 

48 

WWORD(IP-l)  = HMINUS 

1 193 

GO  TO  50 

1 194 

60 

12  = WIDTH/4 

1 195 

IF(I2  .EQ.  0)GO  TO  64 

1 196 

DO  62  K = 1,  12 

1 197 

62 

WORD(K)  = HASTR 

1 198 

64 

11  = WIDTH  - 4*12 

1 199 

IF(I1  .GT.  0)  WORD(I2+l)  = SFIL(Il) 

1200  C 

1201 

50 

CALL  WDDRAW(XSTART,YSTART,DX,DY,SK,SXY, SY,WORD) 

1202 

RETURN 

1203 

END 
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1204 

SUBROUTINE  OIAflT 

(NPL,Xl,X2,XlR,X2R.IXl,IX2,Yi,Y2,YlR,Y2R,IYl, 

L205 

IY2,  XTIT.NDVX 

, YTIT, NDVY) 

1206 

C 

1207 

C 

NPL 

INTEGER 

- 

THE  NUMBER  OF  THE  PLOT  REFERENCED. 

UP  TO  FOUR 

1208 

C 

PLOTS  MAY  BE  PLACED  ON  ONE  OlAPH 

1209 

C 

XI 

REAL 

- 

A FLOATING  POINT  NUMBER,  THE  lABEL 

OF  THE  X 

1210 

C 

AXIS  MINIMUM.  THE  LITERAL  STRING  ' 

'NONE' 

1211 

C 

PRODUCES  NO  LABEL 

1212 

C 

X2 

REAL 

- 

A FLOATING  POINT  NUMBER,  THE  LABEL 

OF  THE  X AXIS 

1213 

C 

MAXIMUM.  THE  LITERAL  STRING  'NONE' 

' PRO- 

1214 

C 

DUCES  NO  LABEL 

1215 

C 

XIR 

REAL 

- 

THE  USER  SPACE  VALUE  OF  THE  X AXIS 

MINIMUM 

1216 

C 

X2R 

REAL 

- 

THE  USER  SPACE  VALUE  OF  THE  X AXIS 

MAXIMUM 

1217 

C 

IX 1 

REAL 

- 

THE  MINIMUM  VALUE  OF  X IN  THE  DATA 

TO  BE  PLOTTED 

1218 

C 

1X2 

REAL 

- 

THE  MAXIMUM  VALUE  OF  X IN  THE  DATA 

TO  BE  PLOTTED 

1219 

C 

Y1 

REAL 

- 

A FLOATING  POINT  NUMBER,  THE  LABEL 

OF  THE  Y 

1220 

C 

AXIS  MINIMUM.  THE  LITERAL  STRING  ' 

'NONE' 

1221 

C 

PRODUCES  NO  LABEL. 

1222 

C 

Y2 

REAL 

- 

A FLOATING  POINT  NUMBER,  THE  LABEL 

OF  THE  Y 

1223 

C 

AXIS  MAXIMUM.  THE  LITERAL  STRING  ' 

NONE' 

1224 

C 

PRODUCES  NO  LABEL 

1225 

c 

YIR 

REAL 

- 

THE  USER  SPACE  VALUE  OF  THE  Y AXIS 

MINIMUM 

1226 

c 

Y2R 

REAL 

- 

THE  USER  SPACE  VALUE  OF  THE  Y AXIS 

MAXIMUM 

1227 

c 

lYl 

REAL 

- 

THE  MINIMUM  VALUE  OF  Y IN  THE  DATA 

TO  BE  PLOTTED 

1228 

c 

IY2 

REAL 

- 

THE  MAXIMUM  VALUE  OF  Y IN  THE  DATA 

TO  BE  PLOTTED 

1229 

c 

XT  IT 

CHAR 

- 

A STRING  OF  LITERAL  CHARACTERS  TERMINATED  BY 

1230 

c 

A 1.  THIS  IS  THE  TITLE  FOR  THE  X AXIS  AND 

1231 

c 

SHOULD  BE  LESS  THAN  30  CHARACTERS 

1232 

c 

NDVX 

INTEGER 

- 

THE  NUMBER  OF  INTERVALS  TO  BE  DRAWN 

I ON  THE 

1233 

c 

X AXIS 

1234 

c 

YTIT 

CHAR 

- 

A STRING  OF  LITERAL  CHARACTERS  TERMINATED  BY 

1235 

c 

A 1.  THIS  IS  THE  TITLE  FOR  THE  Y AXIS  AND 

1236 

c 

SHOULD  BE  LESS  THAN  30  CHARACTERS 

1237 

c 

NDVY 

INTEGER 

- 

THE  NUMBER  OF  INTERVALS  TO  BE  DRAWN 

: ON  THE 

1238 

c 

Y AXIS 

1239 

c 

1240 

c 

ENTRY 

POINTS  (WITH  ARGUMENTS): 

1241 

c 

1242 

c 

PLOTCH 

(NPL,X,Y 

,N,CHARAC)  - PLOTS  ALPHANUMERIC  CHARACTERS  AT  THE 

1243 

c 

COORDINATES  PROVIDED 

1244 

c 

X 

REAL 

- 

A ONE  DIMENSIONAL  ARRAY  CONTAINING 

THE 

1245 

c 

COORDINATES  FOR  X 

1246 

c 

Y 

REAL 

- 

A ONE  DIMENSIONAL  ARRAY  CONTAINING 

THE 

1247 

c 

COORDINATES  FOR  Y 

1248 

c 

N 

INTEGER 

- 

THE  NUMBER  OF  ENTRIES  IN  'X'  AND  'Y 

'.  IF  'N'  = 

1249 

c 

NO  COORDINATES  ARE  PLOTTED. 

1250 

c 

PC  HR 

CHAR*! 

A SINGLE  CHARACTER  TO  BE  USED  FOR  PLOTTING 

1251 

c 

1252 

c 

PLOTLN 

(NPL,X,Y 

,N)  - PLOTS  STRAIGHT  LINES  THROUGH  THE  COORDINATES 

1253 

c 

PROVIDED.  ARGUMENTS  ARE  THE  SAME  AS  FOR 

1254 

c 

PLOTCH. 

1255 

c 

1256 

PARAMETER  (NLINES= 

200,NPLTMX=4) 

1257 

REAL  IXl,  1X2,  lYl 

, IY2,  NONE,  HOLD(12,NPLTMX),  WX(NLINES) 

1258 

REAL  CC(16),  C(I6) 

, WY(NLINES) 
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1259 

1260 
1261 
1262 

1263 

1264 

1265 
' 1266 

1267 

1268 
. 1269 

1270 

1271 

1272 

1273  C 

1274  C 

1275  C 

1276  C 

1277  C 

1278  C 

1279  C 

1280 
1281 
1282 

1283 

1284 

1285 

1286 

1287 

1288 

1289 

1290 

1291 

1292 

1293 

1294 

1295 

1296 

1297 

1298 

1299 

1300 

1301 

1302 

1303 
- 1304 

1305 

1306 
.1307 

1308  C 

1309  C 

1310  C 

1311 

1312 

1313 


CHARACTER*!  XTIT(NDVX),  YTIT(NDVY)  , PCHR,  TITL£(132) 

INTEGER  IX,  lY,  IT,  NTX,  NTY,  INDX(16) 

DIMENSION  X(l),  Y(l)  , XL(1),  YB(1),  XR(1),  YT(1) 

LOGICAL  PLOTON(NPLTMX)/NPLTMX*. FALSE./ 

LOGICAL  LLABPL(NPLTMX) /NPLTMX*. FALSE. / 

DIMENSION  NTICX(NPLTMX) ,NTICY(NPLTMX) ,XMINO(NPLTMX) ,XMAX0 (NPLTMX) 
DIMENSION  YMINO(NPLTMX) , YMAXO( NPLTMX) 

COMMON  /DEVTYP/  IDEVIC , LSW , LTSW ,XYCOOD( 4 ) , LUOUT , LPAGE 
COMMON/ GRFTYP/ ANGLE , IRVRSE , CHS IZ  E ( 9 ) , ITKWIT , LUD  LAG 
DATA  NONE/ 'NONE'/ 

DATA  CC/.0500, .0600, .0310, .0600, . 11, . 15, 

.0800, .0781, .1780, .2500, .0300, .0315, .0600, .040, 

.020,. 025/ 

DATA  LNDX/ 3, 3, 3, 9, 9, 9, 3, 3, 3, 3, 9, 9, 9, 3, 3, 9/ 

THIS  ROUTINE  LNITIALIZES  A GRAPHICS  GRID  OR  CONTOUR  DIAGRAM 
WITH  A FULL  SET  OF  LABELS  AND  SWITCHES  THE  REST  OF  THE  CONTOUR 
GRAPHICS  MATERIAL  TO  THE  GRAPHICS  MODE. 

DEFINE  THE  PLOTTING  REGIONS. 

CHSIZE(4)  = .44 

IF(NPL.GT.NPLTMX.OR.NPL.LT.  1)  STOP  72 
PLOTON(NPL)  = .TRUE. 

HOLD(l,NPL)  = XI 
HOLD(2,NPL)  = X2 
HOLD(3,NPL)  = XIR 
HOLD(4,NPL)  = X2R 
HOLD(5,NPL)  = IXl 
HOLD(6,NPL)  = 1X2 
HOLD(7,NPL)  = Y1 
HOLD(8,NPL)  = Y2 
HOLD(9,NPL)  = YIR 
HOLD(iO,NPL)  = Y2R 
HOLD(ll,NPL)  = lYi 
HOLD(12,NPL)  = IY2 
IF(LLABPL(NPL))  THEN 

HOLD(l,NPL)  = XMINO(NPL) 

HOLD(2,NPL)  = XMAXO(NPL) 

HOLD(5,NPL)  = XMINO(NPL) 

HOLD(6,NPL)  = XMAXO(NPL) 

HOLD(7,NPL)  = YMINO(NPL) 

HOLD(8,NPL)  = YMAXO(NPL) 

HOLD(ll,NPL)  = YMINO(NPL) 

HOLD(12,NPL)  = YMAXO(NPL) 

ENDIF 

CALL  BOXPLT  (XIR,  YIR,  X2R,  Y2R) 

DO  11  I = 1,  16 

11  C(I)  = CC(I)  * (HOLD(INDX(I)+l,NPL)-HOLD(INDX(I),NPL)) 

DETERMINE  NUMBER  OF  CHARACTERS  IN  AXIS  TITLES. 

TITLE(l)  =«  't' 

TITLE(2)  =•  'M' 

MAXT  - 130 
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13U 
1 315 
1 316 

1317 

1318 
1 319 
1 320 
1 321 
1 322 
1 323 
1 324 
1 325 

1326 

1327 

1328 

1329 

1330 

1331 

1332 

1333 

1334 

1 335  C 
1336  C 
1 337  C 

1338 

1339 

1340 

1341 

1342 

1343 

1344 

1345 

1346 

1347 

1348 

1349 

1350 

1351 

1352 

1353 

1354 

1355 

1356 

1357 

1358 

1359 

1360 

1361  C 

1362  C 

1363  C 

1364 

1365 

1 366 

1367 

1368 


CALL  WDCOUNT(XTIT,  NTX) 

IF  (NTX.LT.l)  THEN 

IF  (LUDIAG.GT.O)  WRITE  (LUDIAG, 12) 

ELSE 

DO  15  I = 1,  MAXT 

15  TITL£(I+2)  = XTIT(I) 

C(8)  = (X2R+XlR)/2. 

XRR  = C(8)  + NTX*C(1) 

CALL  L^BEL(TITLE,  C(8),  Y1R-C(6),  XRR,  Y1R-C(6  )+C(  1 3) , 0.0) 
END  IF 

12  FORMATC  NO  ESCAPE  SEQUENCE  IN  TITLE  - GRAFIT') 

CALL  WDCOUNT(YTIT,  NTY) 

IF(NTY.LT.l)  THEN 

IF  (LUDIAG.GT.O)  WRITE  (LUDIAG,  12) 

ELSE 

C(ll)  = (Y1R+Y2R)  / 2. 

DO  16  I = 1,  MAXT 

16  TITL£(I+2)  = YTIT(I) 

CALL  LABEL(TITLE,  X1R-C(7),  C( 1 1 ) , X1R-C( 7 )+NTY*C( 1 ) , 

. C(11)-K:(  13),  1.5707) 

ENDIF 

DECIDE  WHICH  LABELS  TO  USE 
IF(L1ABPL(NPL))  THEN 

CALL  FNUMBR  (XIR-C(IO),  Y1R-C(16),  C(3),  0.0, 

C(2),0.0,C(4) , YMINO(NPL),  6,  1) 

CALL  FNUMBR  (XIR-C(IO),  Y2R-C(16),  C(3),  0.0, 

. C(2) ,0.0,C(4) , YMAXO(NPL),  6,  1) 

CALL  FNUMBR  (X1R-C(9),  Y1R-C(5),  C(3),  0.0, 

C(2)  ,0.0,C(4) , XMINO(NPL),  6,  1) 

CALL  FNUMBR  (X2R-C(9),  Y1R-C(5),  C(3),  0.0, 

C(2),0.0,C(4) , XMAXO(NPL),  6,  1) 

ELSE 

IF(Yl.NE.NONE) 

CALL  FNUMBR  (XIR-C(IO),  Y1R-C(16),  C(3),  0.0, 
C(2),0.0,C(4),  Yl,  6,  1) 

IF(Y2.NE.N0NE) 

CALL  FNUMBR  (XIR-C(IO),  Y2R-C(16),  C(3),  0.0, 
C(2),0.0,C(4),  Y2,  6,  1) 

IF(Xl.NE.NONE) 

CALL  FNUMBR  (X1R-C(9),  Y1R-C(5),  C(3),  0.0, 

C(2),0.0,C(4),  XI,  6,  1) 

IF(X2.NE.N0NE) 

CALL  FNUMBR  (X2R-C(9),  Y1R-C(5),  C(3),  0.0, 

C(2),0.0,C(4),  X2,  6,  1) 

ENDIF 

PUT  TIKS  ON  THE  GRAPH  IF  THE  NUMBER  IS  GREATER  THAN  ZERO. 

IF(LLABPL(NPL) ) THEN 
NDVXLL  = NTICX(NPL) 

NDVYLL  = NTICY(NPL) 

ELSE 

NDVXLL  = NDVX 
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NDVYLL  = NDVY 
ENDIP 

IP  (NDVXLL.GT.  1)  THEN 

DELX  = (X2R  - X1R)/PL0AT(NDVXLL) 

DO  3 I = 1,  NDVXLL-1 
XX  = XIR  + PLOAT(I)*DELX 

3 CALL  LINE  (XX,  YIR,  XX,  Y1R+C(16)) 

DO  7 I = 1,  NDVXLL-1 

XX  = XIR  + PLOAT(I)*DELX 

7 CALL  LINE(XX,  Y2R,  XX,  Y2R-C(16)) 

END  IP 

IP  ( NDVYLL. GT. 1)  THEN 

DELY  = (Y2R  - Y1R)/PL0AT( NDVYLL) 

DO  4 I = 1,  NDVYLL-i 
YY  = YIR  + FLOAT(I)*DELY 

4 CALL  LINE  (XIR,  YY,  X1R+C(15),  YY) 

DO  8 I = 1,  NDVYLL-1 

YY  = YIR  + FLOAT(I)*DELY 

8 CALL  LINE(X2R,  YY,  X2R-C(15),  YY) 

END  IP 

RETURN 

C 

ENTRY  PLOTCH  (NPL,  X,  Y,  N,  PCHR) 

C 

IF  (N.LE.O)  RETURN 

IF(NPL.GT.NPLTMX.OR.NPL.LT.  1)  STOP  72 
IF( .NOT.PLOTON(NPL) ) RETURN 

DX  = (HOLD(4,NPL)-HOLD(3,NPL))  / (HOLD( 6 , NPL)-HOLD( 5 , NPL)  ) 
DY=(HOLD(10,NPL)-HOLD(9,NPL))/(HOLD(12,NPL)-HOLD(i  1,NPL)  ) 
CHSIZE(2)  = (HOLD(iO,NPL)-HOLD(9,NPL) ) * XYCOOD(3)  * CHSIZE(5) 
NLM  = 1 

13  1ST  = NLM 

NLM  = MIN(NLM-1+NLINES,  N) 

DO  5 I = 1ST,  NLM 

WX(I-IST+1)  = HOLD(3,NPL)  + DX  * (X( I )-HOLD( 5 , NPL) ) 

5 WY(I-IST+1)  = HOLD(9,NPL)  -(-  DY  * (Y(  I )-HOLD(  1 1 , NPL)  ) 

CALL  CHPLOT  (WX,  WY,  PCHR,  1,  1,  NLM-IST+i) 

IF(NLM.LT.N)  GO  TO  13 

CHSIZE(2)  = CHSIZE(l) 

RETURN 

C 

ENTRY  PLOTLN  (NPL,  X,  Y,  N) 

C 

IF  (N.LE.O)  RETURN 

IF(NPL.GT.NPLTMX.OR.NPL.LT.  1)  STOP  72 
IF( .NOT.PLOTON(NPL))  RETURN 

DX  = (HOLD(4,NPL)-HOLD(3,NPL))  / (HOLD(6 , NPL) -HOLD( 5 , NPL) ) 
DY=(HOLD(10,NPL)-HOLD(9,NPL))/(HOLD(12,NPL)-HOLD( 1 1,NPL) ) 

NLM  = 1 

14  1ST  = NLM 

NLM  = MIN(NLM-1+NLINES,N) 

DO  6 I = 1ST,  NLM 

WX(I-IST+1)  = HOLD(3,NPL)  + DX  * (X( I )-HOLD( 5 , NPL) ) 

6 WY(I-IST+1)  =•  HOLD(9,NPL)  + DY  * (Y(  I )-HOLD(  1 1 , NPL)  ) 

CALL  LNPLOT  (WX,  WY,  1,  1,  NLM-IST+1) 
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1424 
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IF(NLM.GE.N)  RETURN 
GO  TO  14 


ENTRY  PLOTBAR  (NPL,  XL,  YB , XR,  YT , N,  VALUE) 


IF  (N.LE.O)  RETURN 

IF(NPL.GT.NPLTMX.OR.NPL.LT. 1)  STOP  72 
IF(.NOT.PLOTON(NPL))  RETURN 

DX  = (HOLD(4,NPL)-HOLD(3,NPL))  / (HOLD(6 , NPL)-H0LD( 5 , NPL) ) 

DY  = (tiOLD(10,NPL)-HOLD(9,NPL))  / (HOLD(  1 2,  NPL)-HOLD(  1 1 , NPL)  ) 
NLM  = 1 
20  1ST  = NLM 


XI  = 

XO  = 

Y1  = 

YO  = 

WX(i) 

WX(2) 

WX(3) 

WX(4) 

WY(1) 

WY(2) 

WY(3) 

WY(4) 


DX 

DX 

DY 

DY 


(XR(I)-HOLD(5,NPL)) 

(XL(I)-tiOLD(5,NPL)) 

(YT(I)-HOLD(li,NPL)) 

(YB(I)-HOLD(ll,NPL)) 


NLM  = MIN  (NLM-l+N  LINES,  N) 

CALL  LIN’WID(l) 

DO  21  I = 1ST,  NLM 

HOLD(3,NPL) 

HOLD(3,NPL) 

HOLD(9,NPL) 

HOLD(9,NPL) 

XO 
XO 
XI 
XI 
YO 
Y1 
Y1 
YO 

CALL  PLYGON(WX,  WY,  4) 

TX  = XI  - XO 

TY  = H0LD(10,NPL)  - H0LD(9,NPL) 

IDIGIT  = 0 

IF  (ABS( VALUE). LT. 10. ) IDIGIT  = 1 
NDIG  = 3 

IF( ABS( VALUE). GE. 1000. ) NDIG  = 4 
YOFF  = Y1  - .02  * TY 

IF  (VALUE.lt. 0.0)  YOFF  = YO  - 0. 15  * TY 
FAC  = 1.  / FLOAT(NDIG) 

XST  = FAC  * .95 

IF(VALUE.NE.O.O)  CALL  FNUMBR(X0+0. 01*TX, YOFF,  ; -.025->+.01 
. FAC*TX,0.0,XST*TX, 0.0,0. 12*TY,ABS( VALUE) , NDIG, IDIGIT) 

21  CONTINUE 

CALL  LINWID(3) 

IF(NLM.GE.N)  RETURN 
GO  TO  20 


ENTRY  GRISET  (XL,  YB , XR,  YT) 

CALL  DEFINE  (XL,  YB,  XR,  YT) 

RETURN 

ENTRY  GRILAB  (NPL,  XLL,  YBT,  XRT,  YTT) 
DX  = (XRT-XLL)  / 3. 

DY  = (YTT-YBT)  / 3. 

XINTl  = 10.**(INT(ALOG10(DX))) 

YINTl  = 10.**(INT(ALOG10(DY))) 
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XINT2  = DX  / XINTl 
YINT2  = DY  / YINTl 
IF(XINT2.  LT.  2.0)  THEN 
DX  = XINTl 

ELSE  IF  (XINT2.lt.  5.0)  THEN 
DX  = 2.*XINT1 

ELSE  IF  (XINT2.LT.  10.  ) THEN 
DX  = 5.*XINT1 
ELSE 

DX  = 10.*XINT1 
ENDIF 

IF(YINT2.LT.2.0)  THEN 
DY  = YINTl 

ELSE  IF  (YINT2.lt. 5.0)  THEN 
DY  = 2.*YINT1 

ELSE  IF  (YINT2.lt. 10. ) THEN 
DY  = 5.*YINT1 
ELSE 

DY  = 10.*YINT1 
ENDIF 

XINT2  = XLL  / DX 
YINT2  = YBT  / DY 

IF(XINT2.LT.0.0)  XINT2  = XINT2  - 0.99999 
IF(YINT2.LT.0.0)  YINT2  = YINT2  - 0.99999 
XMINO(NPL)  = DX  * (INT(ABS(XINT2))*SIGN(1. ,XINT2)) 
YMINO(NPL)  = DY  * (INT ( ABS( YINT2 ) )*S IGN ( 1 . , YINT2 ) ) 
XINT2  = XRT  / DX 
YINT2  = YTT  / DY 

IF(XINT2.GT.0.0)  XINT2  = XINT2  + 0.99999 
IF(YINT2.GT.0.0)  YINT2  = YINT2  + 0.99999 
XMAXO(NPL)  = DX  * ( INT( ABS( XINT2 ) )*S IGN( 1 . , XINT2 ) ) 
YMAXO(NPL)  = DY  * (INT( ABS( YINT2) )*S IGN( 1 . , YINT2) ) 
NTICX(NPL)  = (XMAXO(NPL)-XMINO(NPL)+0. 5)  / DX 
NTICY(NPL)  = (YMAX0(NPL)-YMIN0(NPL)+0. 5)  / DY 
LLABPL(NPL)  = .TRUE. 

RETURN 

END 
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1516 

SUBROUTINE  HHDRAW  (XCHAR,  YCHAR,  SX,SXY,SY,  CHNUMB,  SET,  lERR) 

1517 

C 

1518 

C 

XCHAR  REAL  - X STARTING  COORDINATE  OF  THE  CHARACTER  TO  BE 

1519 

C 

DRAWN 

1520 

c 

YCHAR  REAL  - Y STARTING  COORDINATE  OF  THE  CHARACTER  TO  BE 

1521 

c 

DRAWN 

1522 

c 

SX  REAL  - X MATH  SPACE  SIZE  FOR  CHARACTERS 

1523 

c 

SXY  REAL  - SLANT  MODIFIER  FOR  CHARACTERS 

1524 

c 

SY  REAL  - Y MATH  SPACE  SIZE  FOR  CHARACTERS 

1525 

c 

CHNUMB  INTEGER  - INDEXX  TO  IDENTIFY  CHARACTERS  WITHIN  THE  SPECI- 

1  526 

c 

FIED  SET 

1527 

c 

SET  INTEGER  - NUMBER  SPECIFYING  A PARTICULAR  CHARACTER  SET 

1528 

c 

1529 

c 

1530 

REAL  XCHAR, YCHAR, SX, SXY, SY,X(1 28) ,Y( 128) 

1531 

INTEGER  M,  CHNUMB, SET , PEN( 1 28) , ERROR, lERR 

1532 

CHARACTER*!  CHRIRV 

1533 

COMMON  /DEVTYP/  IDEVIC , LSW , LTSW , XYCOOD(4 ) , LUOUT , LPAGE 

1534 

COMMON/GRFTYP/ ANGLE , IRVRSE , CHS IZE( 9 ) , ITKWIT , LUDIAG , LUHSET 

1535 

c 

1536 

c 

1537 

lERR  = 1 

1538 

IF  (SET.GT.l)  GO  TO  3 

1539 

IF  (SET.LT.l)  RETURN 

1540 

c 

1541 

IRV  = IREVCH( CHNUMB,  CHRIRV) 

1 542 

CALL  SYMBOL(XCHAR+CHSIZE(7)  ,YCHAR+CHSIZE(8)  , CHRIRV) 

1543 

RETURN 

1544 

c 

1545 

3 

CALL  HSETS  (CHNUMB , X, Y , PEN, N , SET-1 , ERROR) 

1546 

IF(ERROR.NE.O)  RETURN 

1547 

lERR  = 0 

1548 

c 

1549 

M = N 

1550 

IF  (M.EQ.O)  RETURN 

1551 

c 

1552 

c 

ROTATE  COORDINATES  IF  ANGLE>0.0 

1553 

c 

1554 

SXP  = ABS(XYCOOD(l)) 

1555 

SYP  = ABS(XYCOOD(3) ) 

1556 

OSXP  =1.  /SXP 

1557 

OSYP  =1.  /SYP 

1558 

SXP  = SXP  * SX 

1559 

SYP  = SYP  * SY 

1560 

DO  9 I = 1,  M 

1561 

X(I)  = X(I)  * 0.216  * SXP 

1562 

9 

Y(I)  = Y(I)  * 0.0800  * SYP  + X(I)  * SXY 

1563 

IF  (ANGLE. EQ. 0.0)  GO  TO  4 

1564 

SINX  = SIN(ANGLE) 

1565 

COSX  = COS (ANGLE) 

1566 

DO  6 I = 1,  M 

1567 

XP  = X(I)*COSX  - Y(I)*SINX 

1568 

YP  = X(I)*SINX  + Y(I)*COSX 

1569 

X(I)  = XP 

1570 

6 

Y(I)  = YP 
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4 DO  1 I = 1,  M 

X(I)  = X(I)  * OSXP 

1 Y(I)  = Y(I)  * OSYP 

ADD  THE  ABSOLUTE  POSITION 

DO  7 I = 1,  M 
X(I)  = X(I)  + XCHAR 
7 Y(I)  = Y(I)  + YCHAR 

WRITE  THE  CHARACTER  AS  A SET  OF  CONNECTED  STROKES 

IS  = 1 
IL  = IS 

10  IF(PEN(IL+1).EQ.O.OR. IL.GE.M)  GO  TO  2 
IL  = IL  + 1 
GO  TO  10 

2 IF(IL.GT.IS)  CALL  LINES(X(IS) , Y( IS) ,X(IS+1) , Y( IS+1 ) , IL-IS) 
LF(IL.GE.M)  RETURN 

IL  = IL  + 1 
IS  = IL 
GO  TO  10 
RETURN 

END 
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1595  SUBROUTINE  HSETS  (CHNU’MB.XX.YY,  PEN,  N,  SET,  ERROR) 


1596 

1597 

1598 

1599 

1600 
1601 
1602 

1603 

1 604 

1605 

1606 

1607 

1608 
1609 
IblO 
loll 
1612 

1613 

1614 

1615 

1616 

1617 

1618 

1619 

1620 
1621 
1622 

1623 

1624 

1625 

1626 

1627 

1628 

1629 

1630 

1631 

1632 

1633 

1634 

1635 

1636 

1637 

1638 

1639 

1640 

1641 

1642 

1643 

1644 

1645 

1646 

1647 
1 648 
1649 


C 

C***** **************************************************** ************** 

C HSETS 

C* ************************************************************* ********* 

c 

C THIS  SUBROUTINE  RECEIVES  A SET  NL'MBER  AND  A CHARACTER  NUMBER 
C AND  SEARCHES  THROUGH  'HSETS.DAT'  (FILE  CONTAINING  THE  PACKED 
C HERSHEY  CHARACTER  SUBSETS)  TO  FIND  THE  CHARACTER'S  COORDINATES 
C AND  CORRESPONDING  'PEN'  VALUES. 

C 

PARAMETER(MAXSET=23,MAX1=24) 

LOGICAL  FOPEN/. FALSE./ 

INTEGER  IN(125, 96)  ,IOS, CHAR, SET, COORD, ERROR 
INTEGER  CHNUMB,PEN( 125) ,MASK1 , MASK2 , TABLE(MAX1 ) 

INTEGER  FIRST, LAST, NCHAR(MAXSET) ,TT(64) , IOB(64) , lOBC 
EQUIVALENCE  (TT( 1 ) ,TABLE( 1 ) ) , (TT( 33) , NCHAR( 1 ) ) 

DATA  MASK2/ZFFFF/ ,MASK1/Z7FFFFFFF/ ,NSET/-1/ 

REAL  XX(125) ,YY( 125) 

COMMON/GRFTYP/ ANGLE , IRVRSE, CHS IZE( 9 ) , ITKWIT , LUDIAG , LUHSET 
C 

C OPEN  FILE  CONTAINING  PACKED  HERSHEY  CHARACTER  SETS  IF  NOT 
C PREVIOUSLY  OPENED 
C 

IF(SET.EQ.NSET. AND. FOPEN)  GO  TO  41 
CLOSE(LUHSET) 

C 

C OPEN  A NEW  FILE  FOR  THE  PACKED  HERSHEY  CHARACTER  SUBSETS 
C 

OPEN(UNIT=LUHSET , IOSTAT=IOS , ERR=50 , FILE= ' S YS : HI . CAT/ S ' , 

* ACCESS= 'DIRECT' , FORM= 'BINARY ' , RECL=256 , S IZE=7 30 , 

* BLOCKS IZ  E=2  56 , TYPE= ' CONT IG ' ) 

REWIND  LUHSET 
FOPEN=.TRUE. 

IF( LUDIAG. NE.O)  WRITE(LUDIAG, 20)  LUHSET 
20  FORMAT ( ' HSET  CHARACTER  FILE  OPENED  TO  UNIT  =',I3) 

C 

C READ  STARTING  RECORD  POSITIONS  OF  THE  SETS  INTO  'TABLE' 

C READ  THE  NUMBER  OF  CHARACTERS'  IN  EACH  SET  INTO  'NCHAR' 

C 

READ( LUHSET)  TT 
C 

C CHECK  THAT  THE  SET  AND  CHARACTER  NUMBERS  ARE  VALID 
C 

ERROR=0 

IF(SET.GT.MAXSET)  THEN  ;SET  NOT  IN  FILE 

ERROR=l 
GO  TO  52 
ENDIF 

IF(CHNUMB.GT.NCHAR(SET))  THEN  .CHARACTER  NOT  IN  SET 
ERROR=2 
GO  TO  52 
ENDIF 
C 

C READ  THE  CHARACTERS'  COORDINATES  INTO  THE  'IN'  ARRAY 
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C 

NSET  = SET 

FIRST=TABLE(SET)  ;FIRST  RECORD  OF  SET 
LAST=TABLE(SET+i)  - 1 ,LAST  RECORD  OF  SET 
CHAR=1 
C00RD=0 

DO  30  I=FIRST,LAST 
READ(LUHSET,REC=I)  lOB 
C 

C STORE  DATA  IN  ARRAY  ELEMENTS  FOR  1 CHARACTER  AT  A TIME 
C 

J=0 

32  J=J+i 

COORD=COORD+l 
IN(COORD,CHAR)=IOB( J) 

IF((IOB(J).NE.MASKi).AND.(J.LT.64))  GO  TO  32 
C 

C END  OF  CHARACTER  FOUND;  READ  COORDINATES  FOR  NEXT  CHARACTER 
C 

IF(I0B(J).EQ.MASK1)  THEN 
CHAR=CHAR+1 
C00RD=0 

IF(CHAR.GT.NCHAR(SET))  GO  TO  31 
ENDIF 

IR(J.LT.64)  GO  TO  32 

30  CONTINUE  ;READ  NEXT  RECORD 

31  CLOSE (LUHSET) 

C 

C UNPACK  THE  DATA  FOR  THE  SPECIFIED  CHARACTER  & DETERMINE  THE  REAL 
C VALUES  OF  THE  COORDINATES  AND  THE  INTEGER  VALUE  OF  THE  PEN. 

C 

41  N=0 

40  IF(IN(N+i,CHNUMB).EQ.MASKl)  RETURN  ;END  OF  CHARACTER 

N=N+1 
C 

C FIND  THE  ’PEN’  VALUE  & ELIMINATE  'PEN'  BIT  FROM  PACKED  WORD 
C 

PEN(N)=ISHFT(IN(N,CHNUMB) ,-31) 

IOBC=IAND(IN(N,CHNUMB) ,MASK1) 

C 

C FIND  THE  X & Y COORDINATES 
C 

XX(N)=(ISHFT(IOBC,-16))/100.00 
YY(N)=(IAND(IN(N,CHNUMB) ,MASK2) )/ 1 00. 0 
GO  TO  40  ;UNPACK  NEXT  COORDINATE  AND  PEN  VALUE 
C 

C ERROR 
C 

50  ERROR  = lOS 

IF(LUDIAG.NE.O)  WRITE( LUDIAG, 5 1 ) lOS 

51  FORMATC  ERROR  IN  HSET  - UNABLE  TO  OPEN  CHARACTER  FILE,  ERROR  =', 
. 14) 

52  CLOSE(LUHSET) 

RETURN 

END 
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INTEGER  FUNCTION  IDCHAR  (CHARX) 

C 

(^*********************************************************************** 
C IDHCAR 

Q*********  *************  **********x***  **************************  * ******** 

C 

LOGICAL  ZERO?/. TRUE./ 

INTEGER  IDN(128),  CHAR,  KA,  MASK/127/ 

CHARACTER*!  CHARX,  CHARXX(4) , JA(4),  CHRIRV 
CHARACTER*8  ASCII(16) 

CHARACTER*!  ASCIII(128) 

EQUIVALENCE  ( CHAR, CHARXX) 

EQUIVALENCE  (JA,KA),  (ASCII ,ASCIII) 

DATA  ASCII/  '01234567'  , '89ABCDEF'  , 'GHIJKLMN'  , 'OPQRSTUV  , 

. 'WXYZabcd' , 'efghijkl ' , 'mnopqrst ' , 'uvwxyz  %', 

')[]§rr<','>“" 

4*'  '/ 

C 

C THIS  ROUTINE  INITIALIZES  TH£  IDENTITY  ARRAY  ID  TO  THE  IDENTITY 

C NUMBER  OF  THE  ACCEPTED  ASCII  TERMINAL  CHARACTERS. 

C 

IF(ZEROP)  THEN 
DO  2 I = 1,  128 

2 IDN(I)  = 127 

DO  1 I = 1,  128 

JA(4)  = ASCIII(I) 

KA  = IAND(KA,  MASK) 

1 IF(IDN(KA+1).EQ. 127)  IDN(KA+1)  = I 

ZEROP  = .FALSE. 

ENDIF 

THIS  INTEGER  FUNCTION  RETURNS  THE  IDENTITY  NUMBER  OF  THE  ONE 
BYTE  CHARACTER  ENTERED  THROUGH  THE  ARGUMENT  LIST  AS  A CHARACTER*! 
VARIABLE. 

CHARXX(4)  = CHARX 
CHAR  = IAND(CHAR,  MASK) 

IDCHAR  = IDN(CHAR+1) 

RETURN 

THIS  ENTRY  REVERSES  THE  CHARACTER  PROCESS  - USED  BY  HHDRAW  WHEN 
CALLING  SYMBOL.  CHANGES  THE  NUMBER  BACK  INTO  A CHARACTER 

ENTRY  IREVCH  (ICHR,  CHRIRV) 

IREVCH  = 0 

IF( ICHR. GE. 1. AND. ICHR. LE.  128)  CHRIRV  = ASCIII(ICHR) 

RETURN 

END 
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SUBROUTINE  LABEL  (CHARS,  XL,  YB , XR,  YT , ANGLE) 

COMMON  /DEVTYP/  IDEVIC , LSW, LTSW , XYCOOD( 4 ) , LUOUT , LPAGE 
COMMON/GRFTYP/ XNGLE , IRVRSE , CHS IZE( 9 ) , ITKWIT , LUDIAG , LUHS  ET 
CHARACTER*!  CHARS(*) 

CALL  WDCOUNT( CHARS,  NC) 

IF(NC,LE.O)  THEN 

IF(LUDIAG.GT.O)  WRITE(LUDIAG,  3)  (CHARS( I) , 1=1 , 132) 

3 FORMATC  NO  ESCAPE  SEQUENCE  IN  LABEL  , IX, 1 32A1 ) 

RETURN 
ENDIF 

DX  = (XR  - XL)  / MAX(1.  , FLOAT  (NO) 

DY  = (YT  - YB) 

XNGLE  = ANGLE 

CALL  WDDRAW  (XL,  YB , DX,  0.0,  DX,  0.0,  DY,  CHARS) 

RETURN 

END 
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SUBROUTINE  LINE  (XI,  Yl,  X2,  Y2) 
C 


C LINE 

Q*********************************************************************** 

C 

COMMON  /DEVTYP/  IDEVIC , LSW , LTSW , XYCOOD( 4 ) , LUOUT , LPAGE 
C 

C THIS  ROUTINE  PLOTS  A LINE  FROM  (XI, Yl)  TO  (X2,Y2). 

C THE  PRESENT  ALGORITHM  ALWAYS  PLOTS  FROM  THE  CURRENT  LOCATION  TO 

C THE  TARGET  POINT  THUS  INSURING  PERFECT  LINE  CONTINUITY. 

C 

C 

REAL  IX 1,  1X2,  lYl,  IY2,  IDX,  IDY 
C 


IXl  = XYCOOD(l)*Xl  + XYCOOD(2) 
1X2  = XYCOOD(i)*X2  + XYCOOD(2) 
lYl  = XYCOOD(3)*Yl  + XYC00D(4) 
IY2  = XYCOOD(3)*Y2  + XYCOOD(4) 
IDX  =1X2  - 1X1 
IDY  = IY2  - lYl 

CALL  PUTLNV  ( 1X1 , lYl , IDX, IDY, 1 ) 

RETURN 

END 
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SUB ROUT INE  LINES ( XI , Y 1 , X2 , Y2 , NL) 

C 

C THIS  SUBROUTINE  PLOTS  LINES  FROM  (X1(J),Y1(J))  TO  (X2( J ) , Y2( J)  ) 

C ;^HILE  CONVERTING  TO  RASTER  NUMBERS  THROUGH  SCALE. 

C 

(^  ****************  ******************************  A ************  **Ax**x*  * * 

G LINES 

Q***  **  * ****************************************  ************************* 

G 

PARAMETER  (NLINES=200) 

GOMMON  /BE^/TYP/  IDEVIC  , LSW , LTSW  ,XYCOOD(  4 ) ,LUOUT,L?AGE 
GOMMON/ GRFTYP/ANGLS , IRvUSS , CHS IZ  £( 9 ) , ITKWIT , LUDIAG , LUHSET 
REAL  Xl(NL) ,X2(NL) ,Yi(NL) ,Y2(NL) 

REAL  IXi(NLINES),  lYl(NLINES),  IDX(NLINES),  IDY(NLINES) 


NLM  = NL 
12  = 1 

5 li  = 12 

12  = MIN0(I2-1+NLINES,NL) 

NLMIN  =12-11+1 
DO  10  I = II,  12 

IXl ( I-I 1+1 ) =XYGOOD( 1 ) *X1 ( I )+XYGOOD( 2 ) 
IDX(I-Il+l)=XYGOOD( i)*X2(I)+XYGQOD(2)-IXl(I-Il+l) 
IYi( I-I 1+1 ) =XYGOOD( 3 ) *Y 1 ( I )^XYGOOD( 4 ) 
iO  IDY(I-I1+1)=XYGOOD(3)*Y2(I)+XYGOOD(4)-IY1(I-I1+I) 

G 

GALL  PUTLNV(IX1,IY1, IDX,IDY, NLMIN) 

IF  (I2.GE.NL)  RETURN 

GO  TO  5 

RETURN 

END 
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SUBROUTINE  LNPLOT  (XARRAY,  YARRAY,  II,  12,  13) 

PARAMETER  (NLINES=200) 

REAL  XARRAY(l),  YARRAY(i) 

REAL  XA(NLINES) ,YA(NLINES) ,XB(NLINES) ,YB(NLINES) 
INTEGER  II,  12,  13,  1ST,  I,  NOPTS , NOPT 

N0PTS=(I3-I1+I2)/I2-1 

IST=Ii 

2 NOPT=NOPTS 

NOPT  = MINO  (NLINES ,NOPT) 

DO  1 1=1, NOPT 

:U ( I ) =X.4RRA Y (I3T+I2*I-I2) 

YA  ( I ) = Y A R.RA  Y(I3T+I2*I-I2) 

:Q(  I ) =XARRAY ( IST+I2*!  ) 

YB(  I ) =Y-\RRAY(  IST+I2*!  ) 

1 CONTINUE 

CALL  LINES (XA,YA,XB,YB, NOPT) 

NOPTS=NOPTS-NOPT 

IST=IST+I2*N0PT 

IF( NOPTS. GT.O)  GO  TO  2 

RETITIN 

END 
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SUBROUTINE  MAP IN  (MAPFIL, 

. WIN,  XYZ,  NV,  NE,  NES , NEX,  NP,  NPS , NPX) 

C 

PARAMETER  (NVM=4000 , NEM=400 , NPM=400) 

CHARACTER* 16  MAPFIL 
REAL  XYZ(3,NV),  WIN(4) 

INTEGER  NP(8,NPM),  NPS(4,NPM),  NE(2,NEM),  NES(4,NEM) 

LOGICAL  FIRSTC/.TRUE./ 

C 

C INITL4LIZE  THE  COUNTERS  THE  FIRST  TIME  THRU  THIS  ROUTINE 
C 

IF(FIRSTC)  THEN 
NV  = 0 
NEX  = 0 
NPX  = 0 

FIRSTC  = .FALSE. 

ENDIF 

C 

C OPEN  AND  INPUT  A STRUCTURES  FILE 
C 

NVl  = N'TM 
NEl  = NEM 
NPl  = NPM 

CALL  PLYPLT  (MAPFIL, 0) 

GALL  PLYGNS(WIN,  XYZ(1,NV+1),  NVl,  N£(1,NEX+1),  NES ( 1 , NEX+1 ) , 
. NEl,  NP(1,NPX+1),  NPS(1,NPX+1) , NPl) 

IF(NVl.LE.O)  RETURN 
C 

C UPDATE  THE  EDGE  AND  POLYGON  POINTERS 

Vj 

DO  132  I = NEX+1,  NEX+l+NEl 
DO  132  J = 1,  2 

132  NE(J,I)  = NE(J,I)  + NV 

DO  133  I = NPX+1,  NPX+l+NPl 
DO  133  J = 1,  8 

IF(NP(J,I).GT.O)  NP(J,I)  = NP(J,I)  + NV 

133  GONTLNUE 

NV  = NV  + NVl 
NEX  = NEX  + NEl 
NPX  = NPX  + NPl 
RETURN 
END 
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SUBROUTINE  MAPOUT(WIN,  XYZ , NV,  NE , NES , NEX,  NP,  NPS , NPX) 

C 

SINCLUDE  BUILD.COM  (NLIST) 

REAL  XYZ(3,NV),  WIN(4) 

INTEGER  NP(NPVERT.NPX) , NPS (NSPEC , NPX) , NE(2,NEX),  NES (NSPEC , NEX) 
C 

CALL  DEFINE(WINd)  ,WIN(2)  ,WIN(3)  ,WIN(4)) 

CALL  PLYPL4(NE,NEX,XYZ ,WIN,NES) 

CALL  PLYPL5(NP,NPX,XYZ ,WIN,NPS ,NPVERT) 

CALL  FRAME 

RETURN 

END 
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SUBROUTINE  PLYGON(X,  Y,  N) 

C 

C DRAW  A COMPLETE  POLYGON  AND  FILL  IT  WITH  'LFLMAT' 

C 

PARAMETER  (NPMAX=32) 

GOMMON/DEVTYP/ IDEVIC , LSW , LTSW , XYCOOD( 4 ) , LUOUT , LPAGE 
COMMON/GRFMOD/LFLMAT(5) ,LINWDM(5) ,LCLMAT(5) 
DIMENSION  X(N),  Y(N)  , XL(2*NPMAX) 

r* 

IFdDEVIG.EQ.  0)  RETURN 
NL  = MINOCNPMAX,  N) 

•30  TO  (1,  1,3,  1,  1)  , IDEVIC 
1 DO  11  I = i,  N-i 

11  CALL  LINE(X(I),  Y(I),  X(I+1),  Y(I+1)) 

CALL  LINE(X(N),  Y(N),  X( 1 ) , Y( 1 ) ) 

?^TURN 

3 DO  31  I = 1,  NL 

XL(2*I-1)  = MAX(X(I)  * XYCOOD(l)  + XYC00D(2),  0.0) 
31  XL(2*I)  = MAX(Y(I)  * XYGvDOD(3)  + XYC00D(4)  , 0.0) 

GALL  a30VA(XL(l),  XL(2)) 

CALL  GPOLA  (XL(3),  NL-1) 

RETURN 

END 
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SUBROUTINE  PLYPLl (GBOOSE , ENDSTR, SSTART , SFIRST, SLAST, SVALID, 

II  BLANK) 

THIS  ROUTINE  FINDS  POSITIONS  OF  SUBSTRINGS  WITHIN  A GHARACTER 
STRING.  GOMMAS  -4ND  SPAGES  ARE  SUBSTRING  DELIMITERS.  WHEN 
A VALID  SUBSTRING  IS  FOUND,  ITS  FIRST  AND  LAST  CHARAGTER 
POSITIONS  ARE  RETURNED  TO  THE  GALLING  ROUTINE. 

THIS  ROUTINE  ALSO  INGLUDES  THE  OPTION  OF  GONSIDERING  A GROUP 
OF  BLANKS  SET  OF  BY  GOMMAS  TO  BE  A VALID  SUBSTRING.  IF  SUGH 
A SUBSTRING  IS  FOUND,  THE  POSITIONS  OF  THE  FIRST  -AND  LAST 
3LANKS  ARE  .NOT  RETURNED,  BUT  RATHER  IHE  POSITIONS  OF  THE 
DELLM ITERS  (GOMMAS). 

7A-RLA3LES  USED: 

GFIND  = POSITION  OF  1ST  COMMA  FOUND  (IF  ’BLANK’  OPTION  SET) 
CHOOSE  = I.NTEGER  GO-NTAINING  GHARACTER  STRING 
ENDSTR  = NUMBER  OF  C-4ARACTERS  IN  THE  ENTIRE  STRING 
IB  LANK  = 'BLANK'  FLAG 

(inpuc)  = 0 - BLANKS  NOT  VALID  SUBSTRING 

(input)  = 1 - BLANKS  FOLLOWED  BY  i COMMA  - VALID  SUBSTRING 
(input)  = 2 - BLANKS  FOLLOWED  BY  2 COMMAS  - VALID  SUBSTRING 
(output )=  -1,-2  - SPECIFIED  BLANKS  (1  OR  2)  FOUND 
SFIRST  = POSITION  OF  FIRST  CHARACTER  OF  SUBSTRING 
3LAST  = POSITION  OF  LAST  CHJ^RACTSR  OF  SUBSTRING 
SSTART  = STARTING  POSITION  FOR  SUBSTRING  SEARCH 
STRING  = CHARACTER  ARRAY  CONTAINING  THE  CHARACTER  STRING 
SVALID  = 'V-ALID  SUBSTRING'  FLAG 

= TRUE  - VALID  SUBSTRING  FOUND 
= FALSE  - NO  VALID  SUBSTRING  FOUND 

LOGICAL  SVALID 

I-NTEGER  SF IRST  , SLAST , SSTART , ENDSTR 
INTEGER  I3LANK, GFIND, CHOOSE(20) ,STR(20) 

CHARACTER*!  STRING( 30 ), SPACE/ ' ' / , CR/ ZD/ , COMMA/ Z2C/ 
EQUIVALENCE  ( STR , 3TRI.NG) 

-ASSUME  V-\LID  SUBSTRI-NG 

SVALID=.TRUE. 

FORM  AN  EQUIVALENT  CHARACTER  STRING 

DO  10  1=1,20 
STR(I)=CHOOSE(I) 

INVALID  STARTING  POSITION  - PAST  END  OF  STRING 
IF(ENDSTR.LT. SSTART)  GO  TO  40 
FIND  POSITION  OF  FIRST  ELEMENT  OF  SUBSTRING 
CFIND-0 

DO  20  I=S START, ENDSTR 
SF IRST-I 
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C A COMMA  FOUND 
C 

IF  (IBLANK.NE.O.AND.STRING(I).EQ.COMMA)  THEN 
C 

G FOUND  FIRST  COMMA 

C 

IF  (CFIND.  EQ.O)  THEN 
CFIND=I 

IF  (IBLANK.  EQ.  2)  GO  TO  20 
END  IF 
C 

G FOUND  BLANK  SUBSTRING;  NOTE  POSITIONS  OF  DELIMITERS  (COMMAS) 

C 

SLAST=SFIRST 
SFIRST=CFIND 
IB  LANK=-I  BLANK 
GO  TO  100 
END  IF 
C 

C FOUND  FIRST  CHARACTER  OF  SUBSTRING  - NOW  FIND  LAST 

G 

IF((3TRING(I).NE. SPACE). AND. ( STRING( I ) , NE. CR) . AND. 

1 (STRING(I).NE.COMMA))  GO  TO  60 
20  CONTINUE 

C 

C NO  SUBSTRING  FOUND  - ONLY  DELIMITER 
C 

WRITE(6,998) 

998  FORMAT ( ’ REACHED  THE  END  WITHOUT  FINDING  A NON-BLANK  CHARACTER') 
GO  TO  40  , 

G 

C FIND  POSITION  OF  LAST  CHARACTER  OF  SUBSTRING 

G 

60  IF  (SFIRST.EQ. ENDSTR)  GO  TO  45 

DO  50  J=SFIRST+1 , ENDSTR 
3LAST=J-1 
G 

C FOUND  SUBSTRING  DELLMITER  - CAN  RETURN  NOW 
G 

IF((STRING(J).EQ. SPACE). OR. (STRING(J).EQ. COMMA))  GO  TO  100 
50  CONTINUE 

C 

G NO  SUBSTRING  DELIMITER  =«>  LAST  CHARACTER  OF  SUBSTRING  IS  THE 

C LAST  CHARACTER  OF  THE  STRING 

C 

45  SLAST=«ENDSTR 

GO  TO  100 
C 

G NO  SUBSTRING  FOUND 
C 

40  SVALID-. FALSE. 

100  RETURN 

END 
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SUBROUTINE  PLYPL2 (WINDOW , OPENN .WORLD) 

READ  WINDOW  COORDINATES  AND  STORE  THEM  IN  'WINDOW'  ARRAY.  ALSO 
CHECK  VALIDITY  OF  COORDINATES.  IF  VALID,  'OPENN'  IS  TRUE; 
OTHERWISE,  'OPENN'  IS  FALSE.  WINDOW  COORDINATES  WILL  BE  STORED 
AS  FOLLOWS: 

INDEX  / WINDOW( INDEX) 


1 left 

2 bottom 

3 right 

4 top 

LOGICAL  OPENN 

REAL  WINDOW(4) ,WCRLD(6) 

INITIALIZE 


OPENN=.  FALSE.  ;ASSUME  LNVALID  COORDINATES 


CHECK  VALIDITY  OF  WINDOW  COORDINATES 
DO  30  1=1,2 

IF ( WINDOW ( I ).GE. WINDOW (1+2))  RETURN  ;INVALID  COORDINATES 
30  CONTINUE 
C 

C WINDOW  COORDINATES  VALID 
C 

OPENN=.TRUE. 

RETURN  • 

END 


_ 1 « Q 


2068 

2069 

2070 

2071 

2072 

2073 

2074 

2075 

2076 

2-077 

2078 

2079 

2080 

2081 

2082 

2083 

2084 

2085 

2086 

2087 

2088 

2089 

2090 

2091 

2092 

2093 

2094 

2095 

2096 

2097 

2098 

2099 

2100 

2101 

2102 

2L03 

2104 

2105 

2106 

2107 

2108 

2109 

2110 

2111 

2112 

2113 

2114 
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2120 

2121 
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SUB  ROUT IN  E PL YPL3 ( ARRAY , NARRAY , SP , N PNT , N VE  RT ) 

G 

C THIS  SUBROUTINE  PLOTS  VERTICES  FOUND  WITHIN  THE  WINDOW  AND  THEIR 
C CORRESPONDING  LINE  NUMBERS. 

C 

INTEGER  CHARAC/’.  '/, NARRAY , CHR , NPNT(NVERT) , DIGITS 
REAL  ARRAY(3, NARRAY)  ,SP(4)  ,NUM,NL'MBR,SSP(4) 

REAL  NX,NY,XINC,XSTART 
COMMON/ PLS  CMR/ DOZ , WCX , WG Y , FANGLE , TANAL 
COMMON/DEVTYP/IDEVIC , LSW , LTSW , XYGOOD(4 ) , LUOUT  , LPAGE 
G 

C DEFINE  THE  WINDOW  SPACE 
C 

DO  1 I = 1,  4 
1 SSP(I)  = XYCOOD(I) 

CALL  DEFINE(3P(1) ,S?(2) ,SP(3) ,SP(4) ) 

C 

C PLOT  1 '7ERTEX  AND  NUMBER  AT  A TIME 
G 

DO  20  1=1, NARRAY 
G 

G DO  NOT  PLOT  A 'DELETED'  VERTEX 
G 

IF(NPNTd).EQ.O)  GO  TO  20 
C 

C ADD  PERSPECTIVE 
G 

D = DOZ/((DOZ-l-ARRAY(3,I))*TANAL) 

XX  = ( ARRAY (1,1) -WCX) *D  + WCX 
YY  = (ARRAY(2,  I)-WCY)*D  -t-  WCY 
C 

C DO  NOT  PLOT  A VERTEX  WHICH  IS  OUTSIDE  OF  WINDOW 
C 

IF((XX,LT.SP(1)  ).OR.  (XX.GT.SP(3)))  GO  TO  20 
IF((YY.LT.SP(2)  ).OR.  (YY.GT.3P(4)))  GO  TO  20 
G 

C PLOT  THE  VERTEX  USING  THE  CHARACTER  MODE  OF  THE  HARDWARE 
C 

CALL  SYMBOL(XX,YY, CHARAC) 

C 

C SCALE  MULTIPLIERS  FOR  NUMBERS 
C 

XINC=0.025*(SP(3)-SP(D) 

NX=0.035*(SP(3)-SP(  D) 

NY=0.035*(SP(4)-SP(2)) 

NUMBR=I 

G 

C DETERMINE  NUMBER  OF  DIGITS  'NUM'  (THE  VERTEX  LINE  NUMBER) 

G 

NUM=I 

DIGITS-0 

10  NUM-NUM/10.0 

DIGLTS-DIGITS+1 
IF  (NUM.GE. 1)  GO  TO  10 
C 


2123 

2124 

2125 

2126 

2127 

2128 

2129 

2130 

2131 

2132 

2133 

2134 

2135 

2136 

2137 

2138 

2139 
2 140 

2141 

2142 

2143 
2:44 

2145 

2146 
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C CALCULATE  X COORDINATE  OF  FIRST  DIGIT  OF  THE  NUMBER 
C 

IF  (DIGITS. EQ.  1)  THEN 
XSTART=XX 

ELSE 

IF  ( MOD( DIGITS, 2 ).EQ,0)  THEN 
XSTART=XX-(DIGITS*XINC)/4 

ELSE 

XSTART=XX-(DIGITS*XINC)/2 

ENDIF 

ENDIF 

C 

C PLOT  THE  NL’MBER 
C 

CALL  ?N'JM3R(XSTART , YY-NY , XINC  , 0. 0 , NX,  0.  0, 

* NY,NI:MBR,DIGITS,0)  , print  vertex  NLT«13ER 

20  CONTINUE 

C 

C RESTORE  THE  COORDINATE  SYSTEM 

C 

DO  2 I = 1,  4 

2 XYCOOD(I)  = SSP(I) 

RETURN 

END 
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2147 

2148 

2149 

2150 

2151 

2152 

2*153 

2154 

2155 

2-156 

2157 

2153 

2159 

2160 

2 161 

2162 

2163 

2164 

2165 

2166 

2167 

2168 

2169 

2170 

2171 

2172 

2173 

2174 

2175 

2176 

2177 

2178 

2179 

2180 

2131 

2132 

2133 

2184 

2185 

2186 

2187 

2183 

2139 

2190 

2191 

2192 

2193 

2194 

2195 

2196 

2197 

2198 

2199 

2 200 

2201 
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SUBROUTINE  PL YPL4( ARRAY , NARRAY , VERTX, SP , SPEC ) 

C 

C THIS  SUBROUTINE  PLOTS  EDGES  WHICH  ARE  WITHIN  THE  WINDOW  OR 
C EDGE  SEGMENTS  WHICH  CROSS  A PORTION  OF  THE  WINDOW. 

C 

LOGICAL  VALID 

INTEGER  ARRAY (2, NARRAY ) , SPEC( 4 , NARRAY) 

REAL  VERTX( 3, NARRAY) , SP( 4 ) , SSP(4 ) ,U 1 , V 1 , U2 , V2 
COMMON/ PLSCMR/ DOZ , WCX , WCY , F ANGLE , TANAL 
COMMON/ DEVTYP/  I DEVIC  , LSW  , LTSW , XYC(X)D(  4 ) , LUOUT  , LPAGE 
G 

G DEFINE  THE  WINDOW  SPACE 

r 

DO  1 I = 1,  4 
I SSP(I)  = XYCOOD(I) 

CALL  DEFINE(SP(1),S?(2),SP(3) ,SP(4)) 

C 

G PLOT  ONE  EDGE  AT  A TIME 
G 

LWD  = -1 
LCL  = -1 

DO  150  J=l, NARRAY 
C 

C ADD  PERSPECTIVE 
C 

D = DOZ/((DOZ+VERTX(3,ARBAY(l,J)))*TANAL) 
U1=(VERTX(1,ARRAY(1,J))-WCX)*D  + WCX 
V1=(VERTX(2,ARRAY(1, J))-WCY)*D  + WCY 
D = DOZ/((DOZ+VERTX(3,ARRAY(2,J)))*TANAL) 
U2=(VERTX(1,ARRAY(2,J))-WCX)*D  + WCX 
V2=(VERTX(2,ARRAY(2,J))-WCY)*D  + WCY 
G 

C CLIP  LEFT  EDGE 
G 

IF  (U1.GE,SP(1).AND.U2.GE.S?(1))  GO  TO  50 
IF  (Ul.  LT.SP(1).AND.U2.LT.SP(D)  GO  TO  150 
IF  (Ul.GT.SP(D)  GO  TO  40 
VI  = (V1-V2)*U1/(U2-U1)+V1 
Ul  = SP(1) 

GO  TO  50 

40  V2  = (V2-V1)*U2/(U1-U2)+V2 

U2  = SP(1) 

C 

C CLIP  RIGHT  EDGE 
G 

50  IF  (U1.LE.SP(3).AND.U2.LE.SP(3))  GO  TO  70 

IF  (U1.GT.SP(3).AND.U2.GT.SP(3))  GO  TO  150 
IF  (U1.GT.SP(3))  GO  TO  60 
V2  - (V2-V1)*(SP(3)-U1)/(U2-U1)+V1 
U2  - SP(3) 

GO  TO  70 

60  VI  - (Vl-V2)*(SP(3)-U2)/(Ul-U2)-*-V2 

Ul  - 3P(3) 

C 

C CLIP  BOTTOM  EDGE 
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2206 

2207 

2208 
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2212 

2213 

2214 
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2216 

2217 

2218 

2219 

2 220 
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2225 

2226 

2227 
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C 


IF 

(V1.GE.SP(2). 

AND, 

, V2, 

GE.SP(2))  GO  TO 

90 

IF 

(V1.LT.SP(2), 

AND, 

, V2. 

LT.SP(2))  GO  TO 

150 

IF 

(V1.GT.SP(2)) 

GO 

TO 

80 

Ul 

= (U1-U2)*V1/(V2- 

-V1)-HU1 

VI 

= 3P(2) 

GO 

TO  90 

U2 

= (U2-U1)*V2/ 

(VI- 

-V2)-i-U2 

V2 

= SP(2) 

CLIP  ■ 

rOP  EDGE 

90  IF  (V1.LE.SP(4).AND.V2.LE.SP(4))  GO  TO  liO 
I?  (Vi.GT.SP(4).AND.V2.GT.SP(4))  GO  TO  150 
IF  (V1.GT.3P(4))  GO  TO  100 
U2  = (U2-UI)*(SP(4)-V1)/(V2-V1)+U1 
V2  = SP(4) 

GO  TO  no 

100  Ui  = (U1-U2)*(SP(4)-V2)/(V1-V2)-KJ2 
Vi  = 3P(4) 

C 

C PLOT  THE  EDGE 
C 

no  IF(LWD.NE.SPEC(  1,  J))  THEN 
LWD  = 3PEC(i,J) 

CALL  LIiNWID(LWD) 

ENDIF 

IF(LCL.NE.SPEC(2, J))  THEN 
LCL  = SPEC(2,J) 

CALL  COLOR (LCL) 

ENDIF 

CALL  LINE(U1,  VI,  U2,  V2) 

150  CONTINUE 
C 

C RESTORE  THE  ORIGINAL  COORDINATE  SYSTEM 

C 

DO  2 I = 1,  4 
2 XYCOOD(I)  = SSP(I) 

RETURN 

END 
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2242 

2243 

2244 

2245 

2246 

2247 

2*248 

2249 

2250 

2=251 

2252 

2253 

2254 

2255 

2256 

2257 

2258 

2259 

2 260 

2261 

2262 

2263 

2264 

2265 

2266 

2267 

2268 

2 269 

2270 

2271 

2272 

2273 

2274 

2275 

2276 

2277 

2278 

2279 

2280 

2281 

2282 

2283 

2284 

2285 

2286 

2287 

2288 

2289 

2290 
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2292 
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2295 
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SUBROUTINE  PL YPL5 (ARRAY , NARRAY , VERTX,  SP,  SPEC  , NP'/ERT) 

C 

C THIS  SUBROUTINE  GRAPHS  POLYGONS  WHICH  ARE  WITHIN  THE  WINDOW  OR 
C PARTS  OF  POLYGONS  WHICH  CROSS  A PORTION  OF  THE  WINDOW 
C 

PARAMETER ( MAXLN= 1 0 ) 

LOGICAL  PASSl 

INTEGER  ARRAY ( NPVERT , NARRAY ) , NARRAY , FIRST , S ECOND , NUM , S 1 
INTEGER  INVALD, VINDX, ENDPT , SPEC(4 , NARRAY) 

REAL  VERTX(3,NARRAY) ,SP(4) ,D,SSP(4) 

REAL  Xi,X2,Yl, Y2,X(MAXLN) ,Y(MAXLN) 

COMMON/ PLSCMR/DOZ  ,WCX,WCY,  FANGLE  , TANAL 
COMMON/  DEVT  YP/  IDEVIC  , LSW , LTSW , XYCOOD(  4 ) , LUOUT  , LPAGE 
C 

C DEFINE  WINDOW  SPACE 
C 

DO  1 I = 1,  4 
1 SSP(I)  = XYCOOD(I) 

CALL  DEFINE(SP( 1),SP(2) ,SP(3) ,S?(4) ) 

C 

C PLOT  POLYGONS  ONE  AT  A TLME 
C 

LWD  = -1 
NDX  = -1 
LFL  = -1 

DO  10  I = 1,  NARRAY 
NUM=0 
C 

G DETERMINE  THE  NUMBER  OF  VERTICES  (NON-ZERO  ENTRIES)  IN  THE 

C POLYGON 

C 

DO  15  J=l, NPVERT 

IF(ARRAY(J,I).NE.O)  NUM=NUM+1  , NUMBER  OF  VERTICES  IN  POLYGON 
15  CONTINUE 

C 

G FIND  THE  PERSPECTIVE 

C 

DO  60  IV=1,NUM 

D = DOZ/((DOZ+VERTX(3,ARRAY(IV,I)))*TANAL) 

X(IV)  = (VERTX(1,ARRAY(IV,D)  - WCX)*D  -r  WCX 
Y(IV)  = (VERTX(2,ARRAY(IV,  I))  - WCY)*D  -I-  WCY 
60  CONTINUE 

C 

G PLOT  THE  POLYGON 
C 

IF(SPEG(1,I).NE.LWD)  THEN 
LWD  - SPEC(l.I) 

CALL  LINWID(LWD) 

ENDIF 

IF(SPEC(2, I).NE.NDX)  THEN 
NDX  - SPEC(2,I) 

GALL  COLOR(NDX) 

ENDIF 

IF(SPEC(3,  L).NE.  LFL)  THEN 
LFL  - SPEC(3,I) 
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2305 
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2310 

2311 


CALL  LINES(Xd),  Y(  L ) , X(2),  Y(2),  NUM-1) 
ENDIF 

10  CONTINUE  ;GET  NEXT  POLYGON 

C 

C RESTORE  THE  COORDINATE  SYSTEM 

C 

DO  2 I = L,  4 
2 XYCOOD(I)  = SSP(I) 

RETURN 

END 
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2323 

2324 
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SUBROUTINE  PLYPLT  (FILE  .OPTION) 
$INCLUDE  BUILD.COM 


(NPART=20) 

EXIST,  VALID 

NVERTO,  NELMTO,  NEDGEO,  NPOLYO,  FIRST,  LAST,  lOS 
EDGS(NSPEC,NEDGE) , POLS (NSPEC , NPOLY) , SELECT 
FNM(5),  OPTION,  EDG( 2 , NEDGE ) , POL(NPVERT , NPOLY) 
NPL(2,NPART) , ISPEC(NSPEC) , JP(NPVERT) 

WIN(4),  VER0,NVERT),  SPACE(4) 

SOURCE 

FNAME,  FILENM,  OLDFIL,  FILS 
NOREC,  BLANK 

VALID/.  FALS  E.  / , BLANK/'  '/,  LUNIT/9/,  OLDFIL/'  '/ 
IUNIT/5/,  ZERO/0/ 

(FILENM.FNM) 

COMMON/ PLSCMR/ DOZ , WCX, WCY , FANGLE , TANAL 

COMMON/GRFTYP/ ANGLE, IRVRSE, CHS IZE(9) , ITKWIT , LUDIAG , LUHSET 

*******  ******************************************************************  * 


PARAMETER 

LOGICAL 

INTEGER 

INTEGER 

INTEGER 

INTEGER 

REAL 

CHARACTER*5 
CHARACTER* 1 7 
CHARACTER* 20 
DATA 
DATA 

EQUIVALENCE 


DATA  FILE 

c 

C CREATE  EQUIVALENT  CHARACTER  STRING  OF  FILENAME 
G 

FILENM  = FILE 

IF(FIL£NM.EQ, OLDFIL)  GO  TO  1100 
G 

C READ  FILENAME 
C 

CLOSE  (LUNIT) 

CALL  PLYPLUFNM,  17,  1 , FIRST  , LAST , EXIST , 0) 

IF ( .NOT. EXIST)  GO  TO  90 
FNAME  = BLANK 
DO  10  I = FIRST,  LAST 
J = I - FIRST  + 1 
10  FNAME(J:J)  = FIL£NM(I:I) 

C 

G FILE  EXIST? 

G 

INQUIRE( FIL£=FNAME , IOSTAT=IOS , ERR=9 1 , EXIST=EXIST) 

IF(. NOT. EXIST)  GO  TO  93 
G 

G OPEN  FILE 
G 

OPEN(UNIT-LUN IT , lOSTAT-IOS , ERR=94 , FILE-FNAME , STATUS^ 'OLD ' ) 

REWIND  LUNIT 
G 

C GET(l)  READ  DATA  INTO  VARIABLES  AND  ARRAYS 
C 

READ(LUNIT,FMT=«1500,ERR=98)  SOURCE  , (WINDOW(  I ) ,1  = 1,4) 

IF(SOURCE.NE.  'BUILD'  . AND.  SOURCE.  NE . 'MOVIE'  . AND.  SOURCE.  NE.  'FILNG'  ) 
. GO  TO  98 

READ(LUNIT,FMT-1510,ERR-98)  (WORLD( L ) , I- 1 , 6 ) 

R£AD(LUNIT,FMT-l 520,ERR-98)  NPARTO , NVERTO , NELMTO , NEDGEO 
IF  (NPARTO. LT.O)  GO  TO  98 
NPOLYO-NELMTO -NEDGEO 
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READ(LUNIT,FMT=1520,ERR=98)  ((NPL( I , J) , 1=1 , 2) ,J=1 .NPARTO) 
IF(NVERT0. LE.O)  GO  TO  1090 
DO  1020  J=1,NVERT0 

1020  READ(LUNIT,FMT=1530,ERR=98)  NPOINT( J ) , ( VERTEX( I , J) , 1=1 , 3) 

IF  (NELMTO. LE.O)  GO  TO  1090 
C 

C LNITIALIZE  EDGE  AND  POLYGON  COUNTERS 

C 

NE=0 

NP=0 

DO  1080  J=l, NELMTO 

RF2\D(LUNIT,FMT=1525,ERR=98)  ( JP(  I ) , 1 = 1 , NP'/ERT)  , ( ISPEC(  I ) , 1=1 , 
1 NS  PEC) 

C 

C COUNT  NUMBER  OF  VERTICES  IN  ELEMENT 

C 

NC0N=0 

DO  1030  I = 1,NP'7ERT 
L?  (JP(I).EQ.O)  GO  TO  1035 
1030  NC0N=NC0N+1 

C 

C ELEMENT  IS  EDGE 

C 

1035  IF  (NCON.EQ,  2)  TEEN 

NE=NE+1 
DO  1040  1=1,2 

1040  EDGE(I,NE)=JP(I) 

DO  1050  I=1,NSPEC 
1050  ESPEC(I,NE)=ISPEC(I) 


C ELEMENT  IS  POLYGON 

C 

ELSE 

NP=NP+1 

DO  1060  I=1,NC0N 
1060  ?OLY(I,NP)=JP(I) 

IF  (NCON. LT.NPVERT)  TEEN 
DO  1065  I=NC0N+1,NPVERT 
1065  POLY(I,NP)=0 

ENDIF 

DO  1070  I=1,NSPEC 
1070  PSPEC(I,NP)=ISPEC(I) 

ENDIF 
1080  CONTINUE 
1090  CLOSE(LUT^IT) 

*********  ***Jlt*  ***********************************  **************:k*^ 

C DISPLAY 

Q* ******************************* ********************^**** ************ 

c 

C **SPECIFY  WINDOW** 

C 

1100  IF  (NVERTO.NE.O)  TEEN 

CALL  PLYPL2(WINDOW, VALID, WORLD) 

ELSE 

NOREC  - 'NO  RECORDS' 
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2422 

IF(LUDIAG.GT.O)  WRITS (LUDIAG, 108)  NOREG 

2423 

RETURN 

2424 

ENDI? 

2425 

C 

2426 

C 

IE  VALID  WINDOW  , SET  'SPAGE'  GOORDINATES  TO  'WINDOW' 

,OTHERWISE 

2427 

C 

SET  THE  'SPAGE'  GOORDINATES  TO  'WORLD' 

2428 

c 

*2429 

lE(VALID)  THEN  ;VALID  WINDOW 

2430 

DO  40  1=1,4 

2431 

40 

SPAGE(I)=WINDOW(I) 

'2432 

ELSE 

2433 

IF(LUDIAG.GT.O)  WRITE (LUDIAG, 107) 

2434 

00  41  1=1,2 

2435 

41 

SPAGE(I)=WORLD(I) 

2436 

DO  42  1=3,4 

2437 

42 

SPAG£(I)=W0RLD(I+1) 

2438 

ENDIF 

2439 

G 

2440 

G 

**FIND  GENTSR  OF  WINDOW** 

2441 

G 

2442 

WGX=(SPAGE(3)+SPAC£(l))/2 

2443 

WCY=(SPAGE(4)+SPAGS(2))/2 

2444 

G 

2445 

G 

**INITIALIZE  FIELD  OF  VIEW** 

2446 

G 

2447 

DOZ=10000. 

2448 

FANGLE=90. 

2449 

TANAL=1.0 

2450 

G 

2451 

G 

INITIALIZE  AND  SET  UP  FOR  A SINGLE  GRAPH  - 'NOREG', 

IF  SET,  'WILL 

2452 

G 

INDIGATE  THAT  THERE  ARE  NO  R^GORDS  TO  BE  DISPLAYED 

2453 

G 

2454 

NOREG=BLANK 

2455 

G 

2456 

IF  (OPTION.  EQ.O)  THEN  ;N0  PLOTS  - READ  IN 

DATA 

FILE  ONLY 

2457 

RETURN 

2458 

ELSE  IF  (OPTION.  EQ.  1)  THEN 

2459 

IF  (NEDGEO. EQ.O)  NOREG=’NO  EDGES’ 

2460 

ELSE  IF(OPTION.EQ.  2)  THEN 

2461 

IF  (NVERTO.  EQ.O)  NOREG='NO  VERTIGES' 

2462 

ELSE  IF  (OPTION.  EQ,  3)  THEN 

2463 

IF  (NPOLYO.EQ.O)  NOREG='NO  POLYGONS' 

2464 

ELSE  IF  (OPTION.  EQ.  4)  THEN 

2465 

IF  (NEDGEO.  EQ.O.AND.  NPOLYO.EQ.O)  NOREG='NO 

EDGES 

OR  POLYGONS' 

■2466 

ELSE 

2467 

NOREG- 'INVALID  OPTION' 

2468 

IF(LUDIAG.GT.O)  WRITE( LUDIAG, 108 ) NOREG 

.2469 

RETURN 

2470 

ENDIF 

2471 

G 

2472 

G 

**PLOT** 

2473 

G 

2474 

IF  (NOREG. EQ. BLANK)  THEN 

2475 

IF  (OPTION.  EQ.  1)  THEN 

2476 

GALL  PLYPL4 ( EDGE , NEDGEO , VERTEX , S PAGE , ES PEG ) 
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2483 
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2485 
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2492 

2493 

2494 

2495 

2 496 

2497 

2498 

2499 

2 500 

2501 

2 502 

2503 

2504 

2505 

2506 

2507 

2508 

2509 

2510 

251 1 

2512 

2513 

2514 

2515 

2516 

2517 

2518 

2519 

2520 

2521 

2522 

2523 

2524 

2525 

2526 

2527 

2528 

2529 

2530 

2531 
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ELSE  IF  (OPTION.  EQ.  2)  THEN 

CALL  PLYPL3(VERTEX,NVERT0, S PACE, NPOINT.N VERT) 

ELSE  IF  (OPTION.  EQ.  3)  THEN 

CAL  L PLYPL5 (POLY, N POLYO , VERTEX , S PACE , PS  PEC , NP VERT ) 

ELSE  IF  (OPTION.  EQ.  4)  THEN 

IF(NEDGEO.GT.O)  CALL  PLYPL4(EDGE ,NEDGEO , VERTEX, SPACE , ESPEC) 
IF(NPOLYO.GT.O)  CALL  PLYPL5(P0LY,  NPOLYO  , VERTEX,  SPACE  , PS  PEC, 
NPVERT) 

ENDIF 

ELSE 

IF(LUDIAG.GT.O)  WRITE (LUDL4G,  108)  NOREC 
ENDIF 
RETURN 

(^*:^****4t*:w*:‘:*-****:^r*4:*********4r**  **  **A*:!c*4r*'**  ********  ********  ***4r***  * 

0 “NTRY  PLYGNS 

Q*  X***************************************************************** 

C 

C A ROUTINE  TO  RETURN  THE  COORDINATE  ARRAY  VALUES  FROM  A DATA  FILE 
C 

ENTRY  PL YGNS ( WIN , VER , N VM , E DG , EDGS , NEM , POL , POLS , N EM ) 

NVM  = MIN(NVERT,NVM,NVERTO) 

DO  80  I = I,  4 

30  WIN(I)  = WINDOW(I) 

DO  81  I = i , NVM 
DO  82  J = i,  3 

82  '/ER(J,I)  = VERTEX(J,I) 

31  CONTINUE 

NEM  = MIN(NEDGE,NEM,NE) 

DO  88  I = 1,  NEM 
DO  83  J = 1,  2 

83  EDG(J,I)  = EDGE(J,I) 

DO  84  J = 1,  NSPEC 

34  SDGS(J,I)  = ESPSC(J,I) 

88  CONTINUE 

NPM  = MIN(NPOLY,NPM,NP) 

DO  85  I = 1,  NPM 
DO  86  J = 1,  NPVERT 

86  POL(J,I)  = POLY(J,I) 

DO  87  J = 1,  NSPEC 

87  POLS(J,I)  = PSPEC(J,I) 

85  CONTINUE 

RETURN 

C 

C ERRORS 
C 

90  IF(LUDIAG.GT.O)  WRITE(LUDIAG, 100)  FILE 

RETURN 

91  CLOSE(LUNIT) 

IF  (IOS.EQ.  349)  THEN 

IF(LUDIAG.GT.O)  WRITE(LUDIAG, 100)  FNAME 
ELSE  IF  (lOS.EQ.  324)  THEN 

IF(LUDIAG.GT.O)  WRITE(LUDIAG, 101 ) 

ELSE 

IF(LUDUG.GT.O)  WRITE(LUDIAG,  102)  lOS 
ENDIF 
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2532 

2533 

2534 

2535 

2536 

2537 

2538 

2539 

2 540 

2541 

2542 

2543 

2544 

2545 

2546 

2547 

2 548 

2549 

2550 

2551 

2552 

2553 

2554 

2555 

2556 


SUBROUTINE  PLYPLT 


page  60 


RETURN 

93  IF(LUDIAG.GT.O)  WRITE(LUD1AG, 103) 
RETURN 

94  CLOSE (UNIT=LUNIT , IOSTAT=IOS , ERR=95 ) 

95  IF (LUDIAG.GT.O) WRITE (LUDAIG, 104)  lOS 
RETURN 

98  IF(LUDIAG.GT.O)  WRITE(LUDIAG, 1 10) 

RETURN 


C 
C 
C 

100 

101 

102 

103 

104 

107 

108 
110 
1500 
1510 
1520 
1525 
1530 


FORMATS 


FORMAT ( ' 
FORMAT ( ' 
FORMJ^T(  ’ 
FORMAT ( • 
FORMAT ( ' 
FORMAT ( ' 


INVALID  FILE  DESCRIPTOR’ , 2X,  Ai  7 ) 
NO  RECORDS  IN  FILE') 

INQUIRE  ERROR  = ’,14) 

FILE  DOES  NOT  EXIST') 

FILE  ERROR', 14) 

WINDOW  DEFAULTS  TO  '’WORLD"  ' ) 
F0RMAT(1X,A20,/,/) 

FORMATC  ERROR  - DATA 
FORMAT(A5,4E12. 5) 

FORMAT(6E12.5) 

FORMATC 1615) 

FORMAT(8I5,5X,8I5) 

FORMAT(I5,3E12.5) 

END 


FORMAT  PROBLEMS  — ENTER  NEW 
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2 557 

2558 

2559  C 
2 5bO 
2561 
25b2 

2 563 
2 5bA 
2565 
2 5ob 
2 567 
2568 
25b9 
2 570 
2571 
2 572 
2 573 

2574  C 

2575  C 

2576  C 

2577  C 

2578  C 

2579  C 
2 580  C 
2581  C 
2 582  C 
2583  C 
2 584  C 

2585  C 

2586  C 

2587  C 

2588  C 

2589  C 

2590  C 

2591  G 
2 592  C 

2593  C 

2594  C 

2595  C 

2596  C 

2597  C 

2598  C 

2599  C 

2600  C 

2601  C 

2602  C 

2603  C 

2604  C 

2605 

2606 

2607 

2608 

2609 

2610 
2611 


SUBROUTINE  PROPOL  (NTRIA,  XT  1 , YT 1 , FT  1 , XT2 , YT2  , FT2 , XT3 , YT3 , FT3 , 
1 FL,  NX,  NY) 


PARAMETER 
REAL 
REAL 
REAL 
INTEGER 
REAL 
REAL 
REAL 
REAL 
REAL 
REAL 


(NPT=101) 
XTl(NTRIA)  , 
YTl(NTRIA)  , 
FT  1 (NTRIA), 
MASK(NPT) 
DIFFl(NPT)  , 
SGNl(NPT) , 
DFLl(NPT)  , 
ALFl(NPT) , 


XT2(NTRIA) 
YT 2 (NTRIA) 
FT2(NTRIA) 

DIFF2(NPT) 
SGN2(NPT) , 
DFL2(NPT) , 
ALF2(NPT) 


XT3(NTRIA) 
YT3(NTRIA) 
FT3(NTRIA) 

, DIFF3(NPT) 
SGN3(NPT) 
DFL3(NPT) 

ALF3(NPT),  Xl(NPT) 


X2(NPT) 


X3(NPT),  Yl(NPT),  Y2(NPT),  Y3(NPT) , TEST(NPT) 
DELTA,  MASXl,  MASKS,  RMASK(NPT) 

EQUIVALENCE  (MASK(l),  RMASK(l)) 

DATA  MASKl,  DELTA,  MASKS  / 1.0,  l.OE-20,  Z80000000/ 
DATA  XMN1,YMN1,XMN2,YMN2,XMX1,YMX1 ,XMX2,YMX2/4*0. ,4*100./ 


M■kit^c^cM■k^cic•k■k■k■k■kit■k■k■kic■kit^k^k■kie•k■k■k■ki^■k■k:k 


PROPOL 

(NTRIA,  XTl,  YTl, 
FL,  NX,  NY) 

NTRIA 

LNTEGER 

XTl 

REAL  ARRAY (NTRIA) 

YTl 

REAL  ARRAY (NTRIA) 

FTl 

REAL  ARRAY(NTRIA) 

XT  2 

REAL  ARRAY (NTRIA) 

YT2 

REAL  ARRAY( NTRIA) 

FT2 

REAL  ARRAY (NTRIA) 

XT3 

REAL  ARRAY( NTRIA) 

YT3 

REAL  ARRAY (NTRIA) 

FT3 

REAL  ARRAY (NTRIA) 

FL 

REAL 

NX 

INTEGER 

NY 

INTEGER 

FTl,  XT2,  YT2,  FT2,  XT3,  YT3,  FT3, 


NUMBER  OF  TRIANGLES  IM  LIST  I 
X POSITIONS  OF  FIRST  VERTICES  I 

Y POSITIONS  OF  FIRST  VERTICES  I 
FUNCTION  VALUES  AT  FIRST  VERTICES  I 
X POSITIONS  OF  SECOND  VERTICES  I 

Y POSITIONS  OF  SECOND  VERTICES  I 
FUNCTION  VALUES  AT  SECOND  VERTICES  I 
X POSITIONS  OF  THIRD  VERTICES  I 

Y POSITIONS  OF  THIRD  VERTICES  I 
FUNCTION  VALUES  AT  THIRD  VERTICES  I 
VALUE  OF  F AT  WHICH  CONTOUR  IS  DRAWN  I 
MAXIMUM  VALUE  OF  X POSITIONS  I 
MAXIMUM  VALUE  OF  Y POSITIONS  I 


PROPOL  ASSUMES  A CONTOUR  CROSSING  LIES 
BETWEEN  (XT1,YT1)  AND  (XT2,YT2).  THE  VERTICES  MUST  BE  NUMBERED 
COUNTER-CLOCKWISE  AROUND  THE  TRIANGLE.  THE  CODE  IN  PROPOL  IS  SPEC- 
IALIZED TO  THE  RECTANGULAR  X-Y  CASE  BY  THE  TRANSFORMATION  OF  DO 
LOOP  145.  PLOAR  PLOTS  CAN  BE  FORMED  BY  CHANGING  THIS  TRANSFORMA- 
TION. 

ENTRY  POINTS:  CNTSET,  CNTFRM  (SEE  DOCUMENTATION  OR  LISTING  BELOW) 

********************************* 


IF  (NTRIA  .GT.  NPT)  NTRIA  = NPT 
XD  - (XMN2-XMN1)  / FLOAT(NX-l) 

XB  - ((XMN2-XMN1)-(XMN3-XMN4))  / FLOAT( (NY-l)^(NX-l ) ) 
XC  » (XMN4  - XMNl)  / FLOAT(NY-l) 

YD  - (YMN4  - YMNl  ) / FLOAT(NX-l) 

YB  » ((YMN4-YMN1)-(YMN3-YMN2))  / PLOAT((NY-l)*(NX-l)) 
YC  - (YMN2  - YMNl)  / FLOAT(NX-i) 
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2612 

2613 

2614 

2615 

2616 

'2617 

2618 

2619 

2620 

2621 

2622 

2623 

2624 

2525 

2626 

2627 

2628 

2629 

2630 

2631 

2632 

2633 

2634 

2635 

2636 

2637 

2638 

2639 

2640 

2641 

2642 

2643 

2644 

2645 

2646 

2647 

2648 

2649 

2 650 

2651 

2652 

2653 

2654 

2655 

2656 

2657 

2658 

2659 

2660 

2661 

2 662 

2 663 

2664 

2665 

2666 
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C 


C 

C 

C 


C 

C 

C 


100 


110 


120 


DO  100  I = 1,  NTRIA 
DIFF3(I)  = FT2(I)  - FTl(I) 
DIFFl(I)  = FT3(I)  - FTl(I) 
DIFF2(I)  = FT3(I)  - FT2(I) 
SGN3(I)  = SIGN  (1.0,  DIFF3(D) 
SGNl(I)  = SIGN  (1.0,  DIFFl(I)) 
SGN2(I)  = SIGN  (1.0,  DIFF2(I)) 

DO  no  I = 1,  NTRIA 
DIFF3(I)  = A3S(DIFF3(D)  + DELTA 
DIFFl(I)  = A3S(DIFF1(D)  + DELTA 
DIFF2(I)  = A3S(DIFF2(D)  + DELTA 
DFL3(I)  = SGN3(I)*(FL  - ?T1(I)) 
DFLl(I)  = SGN1(I)*(FL  - FTl(I)) 
DFL2(I)  = SGN2(I)*(FL  - FT2(I)) 
DO  120  I = 1,  NTRIA 


ALF3(I) 
ALFl(I) 
ALF2(I) 
X3(I)  = 
Y3(I)  = 
X1(I)  = 
Y1(I)  = 
X2(I)  = 
Y2(I)  = 
TEST(I) 


= DFL3(I)/DIFF3(I) 

= DFL1(I)/DIFF1(I) 

= DFL2(I)/DIFF2(I) 

XTl(I)  + ALF3(I)*(XT2(I)  - Xn(I)) 

YTl(I)  + ALF3(I)*(YT2(I)  - YTl(I)) 

XTl(I)  + ALFi(I)*(XT3(I)  - XTl(I)) 

YTl(I)  + ALF1(I)*(YT3(I)  - YTl(I)) 

XT2(I)  + ALF2(I)*(XT3(I)  - XT2(I)) 

YT2(I)  + ALF2(I)*(YT3(I)  - YT2(I)) 

= (1.0  - ALF2(I))*ALF2(I) 


IF  TEST  IS  LESS  THAN  ZERO,  THEN  HISS,  OTHERWISE  HIT. 


130 


140 


DO  130  I = 1,  NTRIA 

MASK(I)  = LSHF  (TEST(I),  -31) 

MASX(I)  = HASK(I)  - 1 

X2(I)  = AND  (RMASX(I),  X2(I)) 

Y2(I)  = AND  (RMASK(I),  Y2(I)) 

DO  140  I = 1,  NTRIA 

MASX(I)  = -1  - MASK(I) 

X1(I)  = AND  (RMASK(I),  X1(I)) 
Y1(I)  =»  AND  (RMASK(I),  Y1(I)) 
X1(I)  = X1(I)  + X2(I) 

Y1(I)  = Y1(I)  + Y2(I) 


NOW  PLOT  THE  LINE  SEGMENTS. 


145 


150 


DO  145 

I =•  1 

X1(I) 

» (Xl( 

X3(I) 

- (X3( 

Y1(I) 

- (Yl( 

Y3(t) 

- (Y3( 

DO  150 

I =■  1 

X3(I) 

- AMIN 

X1(L) 

- AMIN 

X3(l) 

- AMIN 

Yl(l) 

- AMIN 

CALL  LINES  ( 

NTRIA 

- 0 

, NTRIA 

I)-l. )*(XD-XB*(Y1(I)-1. 
I)-l. )*(XD-XB*(Y3(I)-l. 
I)-l. )*(YD-YB*(Xl(I)-l. 
I)-l. )*(YD-YB*(X3( L)-l. 
, NTRIA 

KXMAX,  AMAXUXMIN,  X3( 
l(XHAX,  AMAXUXMIN,  Xl( 
UYMAX,  AMAXKYMIN,  Y3( 
l(YMAX,  AMAXUYMIN,  Yl( 
X3,  Y3,  XI,  Yl.  NTRIA) 


) )+XC*(Yl(I)-l 
))+XC*(Y3(L)-l 
) )-*-YC*(Xl(I)-l 
))+YC*(X3(l)-l 

I))) 

1))) 

I))) 

1))) 


. )+XMNl 
. )+XMNl 
. ) +YMN  1 
. ) +YMN 1 
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2667 
2 668 
26o9 

2670 

2671 

2672 

2673 

2674 

2675 

2676 

2677 

2678 

2679 
2o8o 
2681 
2682 


RETURN 


2698 

2699 

2700 

2701 

2702 


C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 


ENTRY  CNTSET  (XMl,  YMl,  XM2,  YM2 , XM3,  YM3,  XM4 , YM4) 

********************************* 

DESCRIPTION:  CNTSET  MAY  BE  CALLED  BY  THE  USER  TO  MOVE  THE  CONTOUR 

PLOT  GENERATED  AROUND  ON  THE  PLOTTING  REGION  OR  TO  STRETCH  OR 
COMPRESS  THE  PLOT.  THE  DATA  STATEMENT  GIVES  THE  DEFAULT  FOR  A 
L4RGE  SQUARE  PLOT.  THE  PLOT  WILL  EXTEND  FROM  XXMIN  TO  XXMAX  IN  THE 
HORIZONTAL  AND  FROM  Y'lMIN  TO  YTMAX  IN  THE  VERTICAL.  ALL  FOUR  OF 
THESE  VALUES  SHOULD  BE  IN  THE  RANGE  I TO  1023. 


2683 

C 

* * * * 

* 

************** 

2 684 
2685 

C 

:^i 

_ 

XMl 

2 686 

'fMNl 

= 

YMl 

2687 

XMN2 

- 

XM2 

2688 

YMN2 

- 

YM2 

2689 

:<MN3 

= 

XM3 

2690 

YMN3 

= 

YM3 

2691 

XMN4 

= 

XM4 

2692 

YMN4 

= 

YM4 

2693 

XMAX 

= 

MAX(XMN1,  XMN2,  XMN3,  XMN4) 

2694 

XMIN 

= 

MIN(XMN1,  XMN2,  XMN3,  XMN4) 

2595 

YMAX 

= 

MAX(YMN1,  YMN2,  YMN3 , YMN4) 

2696 

YMIN 

= 

MIN(YMNi,  YMN2,  YMN3,  YMN4) 

2697 

RETURN 

ENTRY  CNTFRM 


2703  C 

2704  C 

2705  C 

2706  C 

2707  C 

2708  C 

2709  C 

2711  C 

2712  C 

2713  C 

2714 

2715 

2716 

2717 

2718 

2719 


************************ik******** 

DESCRIPTION:  CNTFRM  IS  A USER-CALLED  ROUTINE  TO  PLOT  THE  RECTAN- 

GULAR BOUNDARY  OF  THE  CONTOURED  REGION.  CNTFRM  HAS  NO  ARGU’MENTS 
SINCE  THE  REGION  IS  SPECIFIED  BY  DEFAULT  OR  VIA  A PREVIOUS  CALL  TO 
CNTSET. 

********************************* 

CALL  LINE(XMN1,YMN1,XMN2,YMN2) 

GALL  LINE(XMN2,YMN2,XMN3,YMN3) 

CALL  LINE(XMN3, YMN3,XMN4,YMN4) 

CALL  LINE(XMN4,YMN4,XMNl,YMNi) 

RETURN 

END 
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2720 

2721  C 
1111 

2723 

2724 

2725 
’2726 

2727 

2728 
-2729 

2730 

2731 

2732  C 

2733 

2734 
lll'b 

2736 

2737  C 

2738  C 

2739  C 

2740 

2741 

2742 

2743  C 

2744  C 

2745  C 

2746 

2747 

2748 

2749 

2750 

2751 

2752 

2753 

2754 

2755 

2756 

2757 

2758 

2759 

2760 

2761  C 

2762  C 
2.763  C 

2764 

2765 

2766 

2767 

2768 

2769 

2770  C 

2771  C 

2772  C 

2773 

2774 


SUBROUTINE  PUTCH  (X,  Y,  CHARAC) 

INTEGER  LPAGE(30,  65) 

COMMON/ DEVTYP/ I DEVIC , LSW , LTSW ,XYCOOD( 4 ) , LUOUT , LPAGS 
COMMON/ GRFTY P/ANGLE,  IRVRSE, CHS IZE(9)  , ITKW IT,  LUDIAG,  L ms ET 
CHARACTER*!  CHARAC,  CH(4) 

EQUIVALENCE  (CH,ICH) 

INTEGER  K,  K1 , M,  IK,  IM,  MASK(5) 

INTEGER  ISHFT,  AND,  OR 
LOGICAL  LSW,  LTSW 

DATA  MASK  /ZFFFFOOFF,  ZFFOOFFFF,  ZOOFFFFFF,  ZFFFFFFOO, 
ZFFOOOOOO/,  CHSZ/0.0/ 

ICH  = 0 

CH(1)  = CHARAC 
CHS  = CHSIZE(2) 

GO  TO  (1,2, 3, 5),  IDEVIG 

GALCOMP  SECTION. 

1 CALL  CALSYM  (X,  Y,  CHS,  CH,  0,  0.0,  1) 

LSW  = .TRUE. 

RETURN 

PAGE  PLOT  SECTION. 

2 JXl  = MAX(0,  MIN(IFIX(X) , 1023)) 

JYl  = MAX(0,  MIN(IFIX(Y) ,1023)) 

I = (JXl  + 5)/10  + 1 

J = 65  - (JYl+8)/16 
K = 1/4 
M = I - 4*K 
K1  = 4 - M 

IF(M  .EQ.  0)  K = K - 1 

IM  = IAND(LPAGE(K+4,  J) , MASK(Kl)) 

IK  = lANDdCH,  MASK(5)) 

IF(M  .EQ.  0)  IK  = ISHFTdK,  -24) 

IF(M  .EQ.  3)  IK  = ISHFTdK,  -16) 

IF(M  .EQ.  2)  IK  = ISHFTdK,  -8) 

LPAGE(K+4,  J)  = IOR(IK,  IM) 

RETURN 

LEXIDATA/MATRIX  SECTION 

3 GALL  GSCHSZ  (CHS) 

XL  - MAX(X,0.) 

YL  - MAX(Y,0.) 

CALL  GMOVA  (XL,  YL) 

GALL  GTXTWC  (CH,  1) 

RETURN 

TEKTRONIX  SECTION 

5 CONTINUE 

CALL  MOVEA(X.Y) 
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2775 

2776 

2777 

2778 


CALL  A10UT(1,ICH) 
LTSW  = .TRUE. 

RETURN 

END 
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2779 

SUBROUTINE  PUTLNV  (XI,  Yl,  DX,  DY,  NL) 

2780 

C 

2781 

PARAMETER  (N LINES =2 00) 

2782 

INTEGER  LENGTH,  COUNT 

2783 

REAL  Xi(NL),  Yl(NL),  DX(NL) , DY(NL) 

2784 

INTEGER  MASK1/15/,0P11/12/ ,IVERT/i023/ 

2785 

INTEGER  LPAGE(30,65) , HSYMBL,  HDOT,  HAPOS , HMINUS 

2786 

REAL  JXl(NLINES) ,JY1(NLINES), JX2CNLINES) ,JY2(NLINES) 

2787 

REAL  XY(2,NLINES) , JXS , JYS , IDDX,  IDDY 

2788 

common/ DEVTYP/ I DEVIG , LSW , LTSW , XYCOOD( 4 ) , LUOUT , LPAGE 

2789 

COMMON/GRFTYP/ ANGLE , IR'/RSE , CHSIZE(  9 ) , ITKWIT , LUDIAG , LUHSET 

2790 

COMMON/GREMOD/LFLMAT(5)  ,LINWDM(5)  ,LCLMAT(5) 

2791 

INTEGER  X,  Kl,  M,  Ml,  IK,  LM , MASK(4) 

2792 

LOGICAL  LSW,  LTSW,  IR'/RSE,  LEXL3W 

2793 

DATA  HDOT,  HAPOS,  HMINUS  /Z0000002E,  Z00000027,  Z0C00002D 

2 794 

DATA  MASK  /ZFFFFOOFF,.  ZFFOOFFFF,  ZOOFFFFFF,  ZFFFFFFOO  / 

2795 

DATA  JXS,  JYS  / 2*0.0  / 

2796 

c 

2797 

IF(IDEyiC.EQ.O)  RETURN 

2798 

IF  ( NL.  GT . NLINES . AND.  LUDIAG.  GT . 0 ) WRITE ( LUDIAG  ,1002) 

2799 

1 

002 

FORMAT ( ' ***  BUFFER  SPACE  EXCEEDED  IN  PUTLNV  ***  ’ ) 

2800 

NLP  = MINO(NLINES,NL) 

2801 

c 

2802 

c 

MASK  THE  LINE  SEC23ENT  FOR  CALCOMP  AND  PAPER,  AND  TEKTRONIX. 

2803 

c 

2304 

DO  10  1=1, NLP 

2805 

JXl(I)  = X1(I) 

2306 

JYl(I)  = Y1(I) 

2307 

JX2(I)  = JXl(I)  + DX(I) 

2308 

10 

JY2(I)  = JYl(I)  + DY(I) 

2809 

DO  11  I = 1,  NLP 

2810 

JXl(I)  = MAX(JXKI)  ,0.  ) 

231 1 

JYl(I)  = MAX(JYKI)  ,0.  ) 

2312 

JX2(I)  = MAX(JX2(I) ,0. ) 

2313 

11 

JY2(I)  = MAX(JY2(I) ,0. ) 

2314 

GO  TO  (1,2, 3, 5),  IDE VIC 

2815 

G 

2316 

C 

CALCOMP  SECTION. 

2817 

C 

2318 

1 

DO  16  I = 1,  NLP 

2819 

IF(LSW)  GO  TO  12 

2820 

IF(JXS.EQ.  JXl(I)  .AND.  JYS . EQ,  JY 1 ( I ) )GO  TO  15 

2821 

12 

CALL  CALPLT(JXKI),  JYl(I),  3) 

2322 

LSW  =.  FALSE. 

282  3 

15 

CALL  CALPLT(JX2(I),  JY2(I),  2) 

2324 

JXS-JX2(I) 

2325 

JYS=JY2(I) 

2326 

16 

CONTINUE 

2827 

RETURN 

2828 

G 

2829 

G 

PAGE  PLOT  SECTION. 

2830 

C 

2831 

2 

DO  22  I-l,NLP 

2832 

HSYMBL  - HDOT 

2833 

IF(DX(l).GT.2*DY(l))HSYMBL-HMlNUS 

283 

283( 

283; 

283^ 

2839 

284C 

2841 

2842 

2843 

2844 

234  5 

2846 

234  7 

2843 

2349 

2350 

2351 

2852 

2853 

2854 

2355 

2856 

2357 

2858 

2859 

2860 

2861 

2862 

2363 

2864 

2865 

2866 

2867 

2868 

2369 

28  70 

2871 

2872 

2873 

2874 

2875 

2876 

2877 

2878 

2879 

2880 

2881 

2882 

2883 

2884 

2885 

2886 
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IF(  D Y(  I ) . GT.  2*DX(  I ) )HSYMBL=HAPOS 
IDDX=JX2(I)-JXi(I) 

IDDY=JY2(I)-JY1(I) 

DO  20  L = 1,  9 

JX=JXl(I)+((L-l)*IDDX)/8 

JY=JYl(I)+((L-l)*IDDY)/8 

IX=  (JX+5)/10  + 1 

IY=  65  - (JY+8)/16 

K.=IX/4 

M = IX-  4*K 

IK  = HSYMBL 

K1  = 4 - M 

Ml  = 8*K1 

I?(M  .£Q.  0)  K = :<  - i 

LM  = IAND(LPAGE(K+4,IY)  , MASK(Kl)) 

IF(  M .NE.  0)  IK  = I3HFT(HSYMBL,  Ml) 

20  LPAGE(K+4,IY)  = I0R(LM,  IK) 

22  CONTINUE 

RETURN 

LEXIDATA/ MATRIX  SECTION 

3 IL  = 1 

32  IS  = 1 

CALL  GMOVA(JXi(IL) , JYl(IL)) 

XY(1,IS)  = JX2(IL) 

XY(2,IS)  = JY2(IL) 

31  IL  = IL  + 1 

IF(JXi(IL).NE.XY(  1 ,IS).0R.  JY1(IL).NE.XY(2,IS),0R.  IL.GT.NLP) 
GO  TO  30 
IS  = IS  + 1 
XY(1,IS)  = JX2(IL) 

:CY(2,IS)  = JY2(IL) 

GO  TO  31 

30  CALL  GPLNA(XY,I3) 

IF( IL.GT.NLP)  RETURN 

GO  TO  32 

RETURN 

TEKTRONIX  SECTION 

5 CONTINUE 

DO  40  I=>1,NLP 
IF(LTSW)  GO  TO  42 

IF(JXS.  EQ.  JXKD.AND,  JYS.EQ,  JYi(D)  GO  TO  45 
42  CALL  MOVEA(JXid)  ,JYi(I)) 

LTSW  = . FALSE. 

45  CALL  DRAWA(JX2(I) ,JY2(I)) 

JXS=JX2(I) 

JYS-JY2(I) 

40  CONTINUE 

RETURN 

END 


A " 


2887 

2888 

2889 

2890 

2891 

2892 

2893 

2394 

2895 

2896 
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SUBROUTINE  SETLUT 


DIMENSION  LUT(48) 

DATA  LUT/0, 15, 15,0,0, 15,15,0,15,1,3,5,7,9,11,13, 
. 0, 15,0,  15,0, 15,0, 15,8,1,3,5,7,9, 11, 13, 

. 0,15, 0,0,  15, 0,15, 15, 0,1, 3, 5, 7, 9, 11, 13/ 

CALL  DSLWT  (16,  48,  LUT) 

RETURN 


END 


-207- 
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2897 

2898  C 

2899  C 

2900  C 

2901  C 

2902  C 

2903  C 

2904  C 

2905  C 
290b  C 

2907  C 

2908  C 

2909  C 

2910  C 

2911  C 

2912  C 

2913  C 

2914  C 

2915  C 

2916  C 

2917  C 

2918  C 

2919  G 

2920  C 
292  1 C 
292  2 C 

2923  C 

2924  C 

292  5 C 

2926  C 

2927  C 

2928  C 

2929  C 

2930  C 

293  1 C 

2932  C 

2933  C 

2934  C 

2935  C 

2936  C 

2937  C 

2938  C 

2939  C 

2940  C 

2941  C 

2942  C 

2943  C 

2944  C 

2945  C 

2946  C 

2947  C 

2948  C 

2949  C 

2950  C 

2951  C 


SUBROUTINE  SRFSET(XX,  YY , ZZMIN,  ZZMAX,  NX,  NY) 

THIS  SUBROUTINE  AND  ITS  ASSOCIATED  ENTRIES  CONSTRUCT  AND 
DELIVER  PLOTS  OF  A SURFACE  Z(I,J)  WITH  HIDDEN  LINES  REMOVED 
FOR  I = 1,  NX  AND  J = 1,  NY.  THE  TYPE,  ORIENTATION, 

■\ND  DETAILS  OF  THE  PLOTS  ARE  QUITE  FLEXIBLE  AS  SEEN  BY  CAREFUL 
STUDY  OF  THE  TEST  EROGRAM  AND  THE  RESULTING  OUTPUT 
THE  PARTICULAR  'VERSION  IS  AN  INTERFACE  TO  THE  GENERAL  PURPOSE 
PLOTTLNG  PACKAGE  WHICH  CAN  DRAW  COLOR  PLOTS  ON  THE  CALCOMP, 
LEXIDATA,  PRINTER  OR  TSKTRONICS  (4000'S  SERIES), 

SURFACE  INITIALIZES  THE  SURFACE  PLOTTING  PACKAGE  AND  MUST 
BE  CALLED  EACH  TIME  A NEW  PLOT  IS  DESIRED  TO  RESET  THE 
HIDDEN  LINE  ARRAYS. 

NOTE  THAT  MAX(NX,NY)  MUST  BE  LESS  THAN  NPT 


THE  LOGICAL  PLOTTING  REGION  IS  A 3D  RECTANGULAR  PARALLELE- 
PIPED WITH  8 CORNER  VERTICES. 

XX  REAL  - ARRAY  DIMENSIONED  8 CONTAINING  THE  8 CORNER 

VERTEX  X LOCATIONS.  THE  VERTICES  ARE  NLTHBERED 
AS  SHOWN  ON  THE  SURFACE  GEOMETRY  SHEET  (AVAILABL 
FROM  THE  SPL  LIBRARIAN  OR  THE  AUTHOR). 

YY  REAL  - ARRAY  DIMENSIONED  8 CONTAINING  THE  8 CORNER 

VERTEX  Y LOCATIONS.  THE  VERTICES  ARE  NUMBERED 
AS  SHOWN  ON  THE  SURFACE  (SOMETRY  SHEET  WHICH  IS 
AVAILABLE  FROM  THE  SPL  LIBRARIAN  OR  THE  AUTHOR. 

- THE  VALUE  OF  Z(I,J)  TO  BE  PLOTTED  AT  THE 
BOTTOM  SURFACE  OF  THE  PARALLELEPIPED. 

SMALLER  Z(I,J)  ARE  SET  (I.E.  LIMITED)  TO 
ZZMIN, 

- THE  VALUE  OF  Z(I,J)  TO  BE  PLOTTED  AT  THE 
UPPER  SURFACE  OF  THE  PARALLELEPIPED, 
lARGER  Z(I,J)  ARE  SET  (I.E,  LIMITED)  TO 
ZZMAX. 

NX  INTEGER  - DLMENSION  AND  RANGE  OF  I LN  Z(I,J) 

NY  INTEGER  - DLMENSION  AND  RANGE  OF  J IN  Z(I,J) 


ZZMIN  REAL 


ZZMAX  REAL 


SFRAME  (MODEl)  - PLOTS  THE  FRAME  OF  THE  RECTANGULAR  PARALLELE- 
PIPED PLOTTING  REGION. 

MODEl  INTEGER  - MODEl  = 1 PLOTS  + AT  THE  VERTICES 

= 2 ALSO  PLOTS  LINE  SEGMENTS 
CONNECTING  THE  VERTICES. 


SSKIRT  (ZZ,  NX,  NY,  MODE2)  - PLOTS  ANY  OF  THE  SKIRTS  WHICH  MAY 
BE  DESIRED.  ONLY  ONE  SKIRT  IS  PLOTTED  PER  CALL  AND  THE 
HIDDEN  LINE  ALGORITHM  IS  INVOKED.  THEREFORE,  THE  SIDE 
SKIRTS  (+2,  -2,  +4,  -4)  AND  THE  DATA  SURFACE  BACK  SKIRTS 
(+3,  -3)  SHOULD  ONLY  BE  PLOTTED  AFTER  THE  DATA  SURFACE 
’has  BEEN  CONSTRUCTED  USING  SURFACE.  THIS  ENTRY  DOES  NOT 
PLOT  THE  Z SURFACE  (HERE  THE  DATA  ARE  CALLED  ZZ  TO  AVOID 
DECLARATION  CONFLICTS).  HOWEVER  Z(I,J)  ARE  NEEDED  TO 
DEFINE  THE  SKIRT  POSITIONS. 

ZZ  REAL  - ARRAY  CONTAINING  THE  DATA  TO  BE  PLOTTED  AS  A 
SURFACE 

NX  INTEGER  - DIMENSION  AND  RANGE  OF  I IN  Z(I,J) 
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2952 

C 

NY 

INTEGER  - DLMENSION  AND  RANGE  OF  J IN  Z(I,J) 

2953 

G 

M0DE2  INTEGER  - M0DE2  = i(-l)  LOWER  (UPPER)  FRONT  SRIRT 

2954 

C 

= 2(-2)  LOWER  (UPPER)  RIGHT  SXIRT 

2955 

G 

= 3(-3)  LOWER  (UPPER)  BACK  SKIRT 

2956 

G 

= 4(-4)  LOWER  (UPPER)  LEFT  SKIRT 

2957 

G 

SURFAG  (Z,  NX,  NY,  M0DE3)  - GONSTRUGTS  AND  PLOTS  THE  DATA  SUR- 

2958 

G 

FACE  AND  SETS  THE  HIDDEN  LINE  ARRAYS  WHICH  ARE  USED  IN 

2959 

G 

SURFS  K. 

2960 

G 

Z 

REAL  - ARRAY  DIMENSIONED  (NX, NY)  CONTAINING  THE  DATA 

296  L 

G 

TO  BE  PLOTTED  AS  A SURFACE 

2962 

G 

NX 

INTEGER  - DLMENSION  AND  RANGE  OF  I IN  Z(I,J) 

2963 

G 

NY 

INTEGER  - DIMENSION  AND  RANGE  OF  J IN  Z(I,J) 

2964 

G 

M0DE3  INTEGER  - M0DE3  = 1 PLOTS  THE  UPPER  SURFAGE 

29o5 

c 

=-I  PLOTS  THE  LOWER  SURFACE 

2966 

G 

2967 

PARAMETER  (NPT=101) 

2968 

LOGICAL  SW(1024) 

2969 

REAL  XX(8),  YY(8) 

2970 

REAL  X(8),  Y(8),  H(1280),  G(1280) 

2971 

G 

REAL  AJl(NPT),  AJN(NPT),  AIl(NPT),  AIN(NPT)  , ZVAL(NPT) 

2972 

G 

REAL  RDZVB(NPT),  RDZTV(NPT) 

2973 

LOGICAL  SWITCH 

2974 

REAL  Z(NX,NY),  Xl(NPT) , X2(NPT) , Yl(NPT) , Y2(NPT) 

2975 

REAL  ZZ(NX,  NY) 

2976 

COMMON  /SURCMN/  X,  Y,  ZMIN,  aLAX,  RDZ , RNXMl,  RNYMl,  NNX, 

2977 

G 

2978 

G 

INITIALIZE  HIDDEN  LINE  ARRAYS. 

2979 

G 

2980 

NNX  = NX 

2981 

NNY  = NY 

2982 

IF(MAXO(NX,NY).GT.NPT)  STOP  76  ‘ 

2983 

YMIN  = l.E+25 

2984 

YMAX  = -l.E+25 

2985 

DO  3 I = 1,  8 

2936 

’£MIN  = AMINlCfMIN,  YY(I)) 

2937 

3 

'£MAX  = AMAX1(YMAX,  YY(I)) 

2988 

DO  1 1=1,  1280 

2989 

G(I)  = YMAX 

2990 

1 

H(I)  = YMIN 

2991 

G 

2992 

G 

FOR 

SPECIAL  EFFECTS  ZBOT  AND  ZTOP  MAY  DIFFER  FROM  ZMIN  AND  ZMAX 

2993 

G 

2994 

ZBOT  = ZZMIN 

2995 

ZTOP  = ZZMAX 

2996 

ZMIN  = ZZMIN 

2997 

ZMAX  - ZZMAX 

2998 

RDZ  = 1.0/(ZTOP  - ZBOT) 

2999 

DO  2 I = 1,  8 

3000 

X(I)  - XX(I) 

3001 

2 

Y(I)  - YY(I) 

3002 

RNXMl  - L.O/FLOAT(NX  - 1) 

3003 

RNYMl  - 1.0/FL0AT(NY  - 1) 

3004 

RETURN 

3005 

G 

3006 

C 
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3007  C 

3008  C 
31309 

3010  C 

3011  C 

3012  C 

3013  C 

3014  C 

3015  C 
30 1 0 C 
3017  G 
3013  C 
3019  C 

3 .:o  C 

3021  C 

3022  C 

3023 

3024  0 

3025  C 

3026  C 

3027 

3028 

3029 
3 030 

3031 

3032 

3033 

3034 

3035 

3036 

3037 

3038 

3039 

3040 

3041 
30^2 

3043 

3044 
30a5 

3046 

3047 

3048 

3049 

3050  C 

3051  C 

3052  C 

3053  C 

3054 

3055  C 

3056  C 

3057  C 

3058  C 

3059  C 

3060  C 

3061  C 


ENTRY  SFRAME  (MODEl) 

*-kitkitit-k-k-kititMit-kieicie-kie-k-kit-k:kie:kic*-kit-k:k-k 


DESCRIPTION:  SURFRM  PLOTS  TEE  FRAME  OF  THE  RECTANGULAR  PARALLELO- 

PIPED  PLOTTING  REGION. 


ARGUMENTS : 

MO DEI  INTEGER  MO DEI  = 1 PLOTS  + AT  THE  VERTICES. 

MODEl  = 2 ALSO  PLOTS  LINE  SEGMENTS 
CONNECTING  THE  VERTICES. 

********************************* 

CALL  CHPLOT  (X,  Y,  1,  1,  8) 

NOW  CHECK  THE  VARIOUS  LINES. 


IF  (MODEl  .LE.  1)  GO  TO  12 

CALL  SURF5  (X(l),  Y( 1 ) , X(2),  Y(2)) 

CALL  SURF5  (X(6),  Y(6),  X(2),  Y(2)) 

CALL  SURF5  (X(6),  Y(6),  X(5),  Y(5)) 

CALL  SURF5  (X(l),  Y(l),  X(5),  Y(5)) 

IF  (Y(7).GT.Y(5)  .OR.  X( 7 ) . LT. X( 5 ) ) 

1 CALL  SURF5  (X(5),  Y(5),  X(7),  Y(7)) 

IF  (Y(8).GT.Y(6)  .OR.  X(8) .GT.X(6) ) 

1 CALL  SURF5  (X(8),  Y(8),  X(6),  Y(6)) 

IF  (Y(3).LT.Y(1)  .OR.  X(3 ) . LT. X( 1 ) ) 

1 CALL  SURF5  (X(l),  Y(I),  X(3),  Y(3)) 

IF  (Y(4) .LT.Y(2)  .OR.  X(4).GT.X(2) ) 

1 GALL  SURF5  (X(2),  Y(2),  X(4),  Y(4)) 

IF  (Y(7).GE.Y(5)  .AND.  Y(8) .GE. Y(6) ) 

1 CALL  SURF5  (X(8),  Y(8),  X(7),  Y(7)) 

IF  (X(3).GE.X(6)  .AND.  X( 4 ) . GE . X( 2 ) ) 

1 GALL  SURF5  (X(8),  Y(8),  X(4),  Y(4)) 

IF  (Y(4).LE.Y(2)  .AND.  Y(3) . LE. Y( 1 ) ) 

1 CALL  SURF5  (X(4),  Y(4),  X(3),  Y(3)) 

IF  (X(3).LE.X(1)  .AND.  X(7) .LE.X(5) ) 

1 CALL  SURF5  (X(7),  Y(7),  X(3),  Y(3)) 

12  CONTINUE 

RETURN 


ENTRY  SSKIRT  (ZZ,  NX,  NY,  MODE2) 


********************************* 

DESCRIPTION:  SURFSR  PLOTS  ANY  OF  THE  SKIRTS  WHICH  MAY  BE  DESIRED, 

ONLY  ONE  SKIRT  IS  PLOTTED  PER  CALL  AND  THE  HIDDEN  LINE  ALGORITHM 
IS  INVOKED.  THEREFORE,  THE  SIDE  SKIRTS  (+2,  -2,  M,  -4)  AND  THE 


3062 

3063 

3064 

3065 

3066 

3067 

3068 

3069 

3070 

3071 

3072 

3073 

3074 

3075 

3076 

3077 

3078 

3079 

3080 

3081 

3082 

3083 

3084 

3085 

3086 

3087 

3088 

3089 

3090 

3091 

3092 

3093 

3094 

3095 

3096 

3097 

3098 

3099 

3100 

3101 

3102 

3103 

3104 

3105 

3106 

3107 

3108 

3109 

3110 

3111 

3112 

3113 

3114 

3115 

3116 
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C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


G 

c 

c 


211 


212 


G 

G 

G 


22 


221 


BAGK  SKIRTS  (+3,  -3)  SHOULD  ONLY  BE  PLOTTED  AFTER  THE  DATA  SURF AGE 
HAS  BEEN  GONSTRUGTED  USING  SURF AGE.  THIS  ENTRY  DOES  NOT  PLOT  THE  Z 
SURF AGE  (HERE  THE  DATA  ARE  GALLED  ZZ  TO  AVOID  DEGLARATION  GON- 
FLIGTS).  HOWEVER  Z(I,J)  ARE  NEEDED  TO  DEFINE  THE  SKIRT  POSITIONS. 

ARGUMENTS : 

ZZ  REAL  ARRAY  (NX, NY)  THE  DATA  TO  BE  PLOTTED  AS  A SURF AGE.  I 

NX  INTEGER  DIMENSION  AND  RANGE  OF  I IN  Z(I,J).  I 

NY  INTEGER  DLMENSION  AND  RANGE  OF  J IN  Z(I,J).  I 

MODE2  INTEGER  MODE2  = 1(-1)  LOWER  (UPPER)  FRONT  SKIRT 

MODE2  = 2(-2)  LOWER  (UPPER)  RIGHT  SKIRT 

MODE2  = 3(-3)  LOWER  (UPPER)  BAGK  SKIRT 
MODE2  = 4(-4)  LOWER  (UPPER)  LEFT  SKIRT 

NSKIRT  = IABS(MODE2) 

GO  TO  (21,  22,  23,  22),  NSKIRT 

THE  FRONT  SKIRT  IS  ADDED. 

GONTINUE 
XL  = X(l) 

XR  = X(2) 

YL  = Y(l) 

YR  = Y(2) 

IF  (MODE2  .GT.  0)  GO  TO  211 
XL  = X(5) 

XR  = X(6) 

YL  = Y(5) 

YR  = Y(6) 

DO  212  I = 1,  NX 

FIl  = FLOAT(I-l)/FLOAT(NX-l) 

FIN  = FL0AT(NX-I)/FL0AT(NX-1) 

XA  = XR*FI1  -t-  XL*FIN 
YA  = YR*FI1  + YL*FIN 
GALL  SURF4  (XB,YB,  1,1,  ZZ(I,1)) 

GALL  SURF5  (XA,  YA,  XB , YB) 

RETURN 

THE  RIGHT  OR  LEFT  SIDE  SKIRT  IS  ADDED.  IF  IT  IS  OBSGURED  THE 
HIDDEN  LINE  ALGORITHMS  ARE  USED  SO  GALL  ONLY  AFTER  SURF AGE  IS  USED 
NSK  =-  (4  - NSKIRT)/2 
I - 1 + (NX-1)*NSK 
XST  - X(NSK+1) 

YST  - Y(NSK+1) 

XND  - X(NSK+3) 

YND  =-  Y(NSK+3) 

IF  (MODE2  .GT.  0)  GO  TO  221 
XST  - X(NSK+5) 

YST  - Y(NSK+5) 

XND  - X(NSK+7) 

YND  - Y(NSK-»-7) 

DO  222  J - 1,  NY 

PJl  - FLOAT(J-l)/FLOAT(NY-l) 
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3117 

3118 

3119 

3120 

3121 

3122 

3123 

3124 

3125 
312b 

3127 

3128 

3129 

3130 

3131 

3132 

3133 

3134 

3135 

3136 

3137 

3138 

3139 

3140 

3141 

3142 

3143 

3144 

3145 

3146 

3147 

3148 

3149 

3150 

3151 

3152 

3153 

3154 

3155 

3156 

3157 

3158 

3159 

3160 

3161 

3162 

3163 

3164 

3165 

3166 

3167 

3168 

3169 

3170 

3171 


FJN  = FLOAT(NY-J)/FLOAT(NY-l) 

XA  = XND*FJ1  + XST*FJN 
YA  = YND*FJ1  + YST*FJN 
CALL  SURF4  (XB.YB,  I,J,  ZZ(I,J)) 

C 

C THE  SKIRT  MAY  BE  OBSCURED.  CHECK  ON  TOP  OR  BOTTOM. 

C 

K = XB  -t-  0.  5 

IF  (MODE2  .GT.  0)  YB  = AMIN1(YB,  G(K)) 

IF  (MODE2  .LT.  0)  YB  = AMAX1(YB,  H(K)) 

IF  (MODE2.GT.O  .AND.  YA.LT.G(K))  CALL  SURF5  (XA,  YA , XB , YB) 

IF  (MODE2.LT.O  .AND.  YA.GT.H(K))  CALL  SURF5  (XA,  YA , XB , ’IB) 

222  CONTINUE 
RETURN 


C THE  BACK  SKIRT  IS  ADDED  (ASSUMED  CALLED  AFTER  SURFACE). 

C 

23  CONTINUE 

XL  = X(3) 

YL  = Y(3) 

XR  = X(4) 

YR  = Y(4) 

IF  (MODE2.GT.O)  GO  TO  231 
XL  = X(7) 

YL  = Y(7) 

XR  = X(8) 

YR  = Y(8) 

231  DO  232  I = 1,  NX 

FIl  = FLOAT(I-l)/FLOAT(NX-l) 

FIN  = FLOAT(NX-I)/FLOAT(NX-l) 

XA  = XR*FI1  -t-  XL*FIN 
YA  = YR*FI1  + YL*FIN 
CALL  SURF4  (XB,YB,  I, NY,  ZZ(I,NY)) 

K = XB  + 0.  5 

IF  (MODE2  .GT.  0)  YB  = AMINl  (YB , G(K)) 

IF  (MODE2  .LT.  0)  YB  = AMAXl  (YB,  H(K)) 

IF  (FLOAT(MODE2)*(YB-YA)  .GT.  0.0)  GALL  SURF5(XA,  YA,  XB , YB) 

232  CONTINUE 
RETURN 

C 

G 

C 

C 

ENTRY  SURFAC  (Z,  NX,  NY,  MODE3) 

C 

C A******************************** 

C 

C DESCRIPTION:  SURFACE  CONSTRUCTS  AND  PLOTS  THE  DATA  SURFACE  AND  SET 

C THE  HIDDEN  LINE  ARRAYS  WHICH  ARE  USED  IN  SURFSK. 

C 

C ARGUMENTS : 


c 

z 

REAL  ARRAY  (NX, NY) 

THE  DATA 

TO  BE  PLOTTED 

AS  A 

SURFACE. 

I 

c 

NX 

INTEGER 

DIMENSION 

AND  RANGE  OF 

I IN 

Z(I,J). 

I 

c 

NY 

INTEGER 

DIMENSION 

AND  RANGE  OF 

J IN 

I 

c 

MODE3 

INTEGER 

MODE3  - 1 

PLOTS  THE  UPPER 

SURFACE 

I 

n T 
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3227 

3228 

3229 

3230 

3231 

3232 
3 

233 

3234 

3235  C 

3236  G 

3237  C 

3238 

3239 

3240 

3241 

3242 

3243 

3244 

3245 

3246 

3247 

3248 

3249 

3250 

3251 

3252 

3253  C 

3254  C 

3255  C 

3256 

3257 

3258 

3259 

3260 

3261 

3262 

3263 

3264 

3265 

3266 

3267 

3268 

3269 

3270 

3271 

3272 

3273 

3274 

3275  C 

3276  G 

3277  G 

3278 

3279 

3280 

3281 


YA  = AMAXl(YKI),  H(IXH)) 

YB  = AMAX1(Y2(I),  H(IXH)) 

IF  (YB.GT.YA)  GALL  SURF5  (X1(I),YA,  X2(I),YB) 

GO  TO  35 

39  YA  = AMINl(YKI),  G(IXH)) 

YB  = AMIN1(Y2(I),  G(IXH)) 

IF  (YB.LT.YA)  GALL  SURF5  (X1(I),YA,  X2(I),YB) 

GO  TO  35 

THIS  IS  A SLANTED  LINE  SEGMENT. 

38  DIX  = 1.0/FLOAT(IXB  - IXA) 

SWITGH  = .TRUE. 

NSWT  = IXB  - IXA  + 1 
DO  36  K = IXA,  IXB 
3W(X)  = .TRUE. 

IF  (X2(I),GT.X1(I))  YK  = Y1(I)*(IXB-X)*DIX  + Y2( I ) *(K-IXA) *DIX 
IF  (X2(I).LT.X1(I))  YK  = Y2( I ) *( IXB-K) *DIX  + Yl( I )*(X-IXA)*DIX 
IF  ( (MODE3.lt. 0 .AND.  G(K) .GE. YK-0. 5) 

1 .OR.  (MODE3.GT.O  .AND.  H(K) . LE. YK+0. 5) ) GO  TO  36 

SWITGH  = .FALSE. 

SW(X)  = .FALSE. 

NSWT  = NSWT  - 1 

36  GONTINUE 

IF  (SWITGH)  GALL  SURF5  (X1(I),  Y1(I),  X2(I),  Y2(I)) 

IF  (SWITGH  .OR.  NSWT.EQ.O)  GO  TO  35 

PART  OF  THE  LINE  IS  OBSCURED  SO  WE  NEED  TO  PLOT  SEGMENTS, 

SW(IXA-l)  = .FALSE. 

SW(IXB+1)  = .FALSE. 

DO  41  K = IXA,  IXB 

IF  (X2(I).GT.X1(D)  YK  = Y1(I)*(IXB-K)*DIX  + Y2(  I ) *(K-IXA)  *DIX 
IF  (X2(I).LT.X1(I))  YK  = Y2( I)*(IXB-K)*DIX  + Y 1 ( I ) *( K-IXA ) *DIX 
IF  (.NOT.SW(K)  .OR.  SW(K-l))  GO  TO  51 
XA  = K 
YA  = YK 

IF  (K.  EQ.IXA)  GO  TO  51 
IF  (MODE3.GT.O)  YA  =»  AMINl  (H(K),  YK) 

IF  (MODE3.lt. 0)  YA  =■  AMAXl  (G(K),  YK) 

51  IF  (.NOT.SW(K)  .OR.  SW(K+1))  GO  TO  41 
IF  (K.EQ.  IXB)  GO  TO  52 

IF  (MODE3.GT.O)  YK  - AMINl  (H(K),  YK) 

IF  (MODE3.LT.O)  YK  =■  AMAXl  (G(K),  YK) 

52  CALL  SURF5  (XA, YA,FLOAT(K) ,YK) 

41  CONTINUE 

35  CONTINUE 

37  CONTINUE 

PLOT  THE  I TO  I-t-1  LINE  SEGMENTS  IF  NOT  HIDDEN. 

DO  33  I - 2,  NX 
IXB  - X2(I)  + 0.5 
IXA  - X2(l-1) 

DIX  • l.O/FLOAT(lXB  - IXA) 
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3296 

3297 

3298 

3299 

3300 

3301 

3302 

3303 

3304 

3305 

3306 

3 307 
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3310 

3311 
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SWITC8  = .TRUE. 

NSWT  = IXB  - IXA  + 1 
DO  34  K.  = IXA,  IXB 
SW(K.)  = .TRUE. 

YK  = Y2(I-1)*(IXB-K:)*DIX  + Y2(I)*(K-IXA)*DIX 
IF  (MODE3.GT.O)  H(X)  = AMAX1(H(K),  YK) 

IF  (M0DE3.lt. 0)  G(K)  =AMIN1(G(K),  YK) 

IF  ((M0DE3.LT.0  .AND.  G(K)  .GE.  YK-0.  5) 

1 .OR.  (MODE3.GT.O  .AND.  H(K) . LE . YK+0.  5) ) GO  TO  34 

SWITCH  = .FALSE. 

SW(K)  = .FALSE. 

NSWT  = NSWT  - 1 
34  CONTINUE 

IF  (SWITCH)  CALL  SURF5  (X2(I-1),  Y2(I-1),  X2(I),  Y2(I)) 

IF  (SWITCH  .OR.  NSWT.EQ.O)  GO  TO  33 
C 

C PART  OF  THE  LINE  IS  OBSCURED  SO  WE  NEED  TO  PLOT  SEGMENTS. 

C 

SW(IXA-l)  = .FALSE. 

SW(IXB+i)  = .FALSE. 

DO  44  K = IXA,  IXB 

YK  = Y2(I-i)*(IXB-K)*DIX  + Y2( I ) *(K-IXA) *D IX 
IF  (SW(K)  .AND.  .NOT.SW(K-D)  XA  = K 
IF  (SW(K)  .AND.  .NOT.SW(K-i))  YA  = YK 

IF  (SW(K)  .AND.  .NOT.SW(K+i))  CALL  SURF5  (XA , YA , FLOAT(K) , YK) 
44  CONTINUE 

33  CONTINUE 

C 

31  CONTINUE 

RETURN 

END 
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3313 

3314  C 

3315  G 

3316  C 

3317  C 

3318  C 

3319  G 

3320  G 

3321  G 

3322  G 

3323  G 

3324 

3325 

3326  G 

3327 
3 328 

3329 

3330 

3331 

3332 

3333 

3334 

3335 

3336 

3337 

3338 

3339 

3340 

3341 

3342  G 

3343  G 

3344  G 

3345  G 

3346  G 

3347  G 

3348  C 

3349  G 

3350  G 

3351 

3352  G 

3353 

3354 

3355 

3356 


SUBROUTINE  SURF4  (XVAL,  YVAL,  I,  J,  ZIN) 

********************************* 


THIS  IS  AN  AUXILIARY  ROUTINE  TO  SURFAGE.  IT  PERFORMS  A TRILINEAR  I 
TERPOIATION  IN  THE  3D  REGTANGLE  OUTLINED  BT  (X(I),  Y(I))  ON  THE 
PLOTTING  SURFACE  FOR  I = 1,  8.  THE  TEXT  WILL  BE  SUBSTITUTED 

IN  LINE  WHEN  THE  ASC  COMPILER  BUG  HAS  BEEN  FIXED. 


********************************* 


REAL  X(8),  Y(8) 

COMMON  /SURCMN/  X,  Y,  ZMIN,  ZMAX,  RDZ , RNXMi,  RNYMl,  NNX,  NNY 


1 

2 

3 

1 

2 

3 


FIl  = FL0AT(I-1)*RNXM1 
FJl  = FL0AT(J-1)*RNYM1 
FIN  = FL0AT(NNX-I)*RNXM1 
FJN  = FL0AT(NNY-J)*RNYM1 
ZVAL  = AMAXl  (ZIN,  ZMIN) 

ZVAL  = AMINl  (ZVAL,  ZMAX) 

XVAL  = RDZ*(ZVAL-ZMIN)*(FJN*(FI1*X(6) 
+ FJl*(FIi*X(8)  + FIN*X(7))) 

+ RDZ*(ZMAX-ZVAL)*(FJN*(FI1*X(2) 
+ FJ1*(FI1*X(4)  + FIN*X(3))) 
YVAL  = RDZ*(ZVAL-ZMIN)*(FJN*(FI1*Y(6) 
+ FJ1*(FI1*Y(8)  + FIN*Y(7))) 

+ RDZ*(ZMAX-ZVAL)*(FJN*(FI1*Y(2) 
+ FJ1*(FI1*Y(4)  + FIN*Y(3))) 


RETURN 


+ FIN*X(5)) 
+ FIN*X(D) 
+ FIN*Y(5)) 
+ FIN*Y(1) ) 


********************************* 


THIS  SUBROUTINE  IS  A GENERAL-PURPOSE  GRAPHICS  INTERFACE  FOR  USE 
WITH  THE  SURFACE  SUBROUTINE  FOR  3D  SURFACE  PLOTS  WITH  HIDDEN  LINES 
REMOVED. 

********************************* 

ENTRY  SURF5  (XI,  Yl,  X2,  Y2) 

IF  ( ((Xl-X2)**2  + (Yl-Y2)**2)  .GT.  2.25) 

1 CALL  LINE  (XI,  Yl,  X2,  Y2) 

RETURN 


END 
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3357 

3358  C 

3359 

3360 

3361 

3 362  C 
3363  C 
3 364  C 

3365  C 

3366  C 

3367 

3368 

3369 

3370 
337  1 
3372 


SUBROUTINE  SYMBOL  (XCHAR,  YCHAR,  CHARAC) 

COMMON  /DEVTYP/  IDEVIC , LSW , LTSW , XYCOOD(4 ) , LUOUT , LPAGE 
COMMO N/ GRFT Y P/ ANGLE , IRVRSE , CHS IZ E ( 9 ) , ITKW IT , LUD  lAG , LUES ET 
CHARACTER*!  CHARAC 

THIS  SUBROUTINE  USES  THE  HARWARE  CHARACTERS  TO  PLOT  DATA 

POINTS  AT  THE  LOCATION  SPECIFIED  BY  (XCHAR, YCHAR)  IN  THE  PLOTTING 

REGION  DETERMINED  BY  XYCOOD. 


IF  (IDEVIC, EQ. 4)  CALL  IOWAIT(8) 

X = XYCOOD(i)*XCHAR  + :CYCOOD(2)  - CHSIZE(2)  *CHSIZE( 3 ) 
Y = XYCOOD(3)*YCHAR  + XYCOOD(4)  - CHSIZ£(2)*CHSIZE(4) 
CALL  PUTCH  (X,  Y,  CHARAC) 

RETURN 

END 
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3373 

3374 

3375 

3376 

3377 

3378 

3379 
‘3380 

3381 

3382 
*3383 

3384 

3385 

3386 

3387 
3 388 

3389 

3390 

3391 

3392 

3393 

3394 

3395 

3396 

3397 

3398 

3399 

3400 

3401 

3402 

3403 

3404 

3405 

3406 

3407 

3408 

3409 

3410 

3411 

3412 

3413 

3414 

3415 

3416 
-3417 

3418 

3419 

3420 
■ 3421 

3422 

3423 

3424 

3425 

3426 

3427 


SUBROUTINE  VIEWTR(XDC , WINDOW , VERTEX, NV , EDGE , ESPEC , NE , 

. POLY,PSPEC,NP) 

C 

C THIS  SUBROUTINE  PLOTS  EDGES  AND  POLYGONS  WHICH  ARE  WITHIN  THE  WINDOW 
C EDGE  SEGMENTS  WHICH  CROSS  A PORTION  OF  THE  WINDOW. 

C 

REAL  VERTEX(3,NV) , WINDOW(4),  XYZ(3,8) 

INTEGER  EDGE (2, NE) , ESPEC(4,NE),  POLY(8,NP),  PSPEC(4,NP) 

REAL  U1,V1,U2,V2,X(8),Y(8),XDC(4,4) 

C 

C DEFINE  THE  WINDOW  SPACE 
C 

CALL  DEFINE ( WINDOW (1 ) , WIN  DOW ( 2 ) , WINDOW ( 3 ) , WIN  DOW ( 4 ) ) 

C 

DOZ  = iOOOO. 

FANGL£=90. 

TANAL  =1.0 

WCX  = 0.  5 * (WINDOWC  l)+WINDOW(3) ) 

WCY  = 0,5  * (WINDOWC 2)+WINDOW(4) ) 

C 

C PLOT  ONE  EDGE  AT  A TIME 
C 

LWD  = -1 
LCL  = -1 
LFL  = -1 
DO  150  J=1,NE 
C 

C MOVE  VERTICES  INTO  A LOCAL  WORK  ARRAY 
C 

DO  151  I = 1,  2 
DO  151  K = 1,  3 

151  XYZ(K,I)  = VERTEX(K,EDGE(I, J)) 

C 

C .4PPLY  THE  TRANSFORM 
C 

DO  152  I = 1,  2 
U1  = XYZ(1,I) 

U2  = XYZ(2,I) 

U3  = XYZ(3,I) 

XYZ(1,I)  = XDC(1,1)*U1  + XDC(1,2)*U2  + XDC(1,3)*U3  + XDC(1,4) 

XYZ(2,I)  = XDC(2,1)*U1  + XDC(2,2)*U2  + XDC(2,3)*U3  + XDC(2,4) 

152  XYZ(3,I)  = XDC(3,1)*U1  + XDC(3,2)*U2  + XDC(3,3)*U3  + XDC(3,4) 

C 

C ADD  PERSPECTIVE 
C 

D - DOZ/((DOZ+XYZ(3, 1))*TANAL) 

U1=(XYZ(1, 1)-WCX)*D  + WCX 
V1-(XYZ(2, 1)-WCY)*D  + WCY 
D - DOZ/((DOZ+XYZ(3,2))*TANAL) 

U2-(XYZ( 1 ,2)-WCX)*D  + WCX 
V2=(XYZ(2, 2)-WCY)*D  + WCY 
C 

C CLIP  LEFT  EDGE 
C 

IF  (Ui.GE.WINDOW(i).AND.U2.GE.WINDOW(l))  GO  TO  50 


T 1 -• 
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IF  (Ul.LT.WINDOW(l).AND.U2.LT.WINDOW(  D)  GO  TO  150 
IF  (Ul.GT.WINDOW(l))  GO  TO  40 
VI  = (V1-V2)*U1/(U2-U1)+V1 
U1  = WINDOW(l) 

GO  TO  50 

40  V2  - (V2-V1)*U2/(U1-U2)+V2 

U2  = WINDOWS) 

C 

C CLIP  RIGHT  EDGE 
C 

50  IF  (Ul.LE.WINDOW(3).AND.U2.LE.WINDOW(3))  GO  TO  70 

IF  (Ul.GT.WINDOW(3).AND.U2,GT.WINDOW(3))  GO  TO  150 
IF  (Ul.GT.WINDOW(3) ) GO  TO  51 

V2  = (V2-V1)*(WIND0W(3)-U1)/(U2-U1)+V1 
U2  = WINDOW(3) 

GO  TO  70 

51  VI  = (V1-V2)*(WIND0W(3)-U2)/(U1-U2)+V2 

U1  = WINDOW(3) 

C 

C CLIP  BOTTOM  EDGE 
C 

70  IF  (Vl.GE.WINDOW(2).AND. V2.GE.WINDOW(2))  GO  TO  90 

IF  (Vl.LT.WINDOW(2).AND.V2.LT.WINDOW(2))  GO  TO  150 
IF  (Vl.GT.WINDOW(2))  GO  TO  80 
U1  = (U1-U2)*V1/(V2-V1)+U1 
VI  = WINDOW(2) 

GO  TO  90 

80  U2  = (U2-U1)*V2/(V1-V2)+U2 

V2  = WINDOW(2) 

C 

C CLIP  TOP  EDGE 
C 

90  IF  (Vl.LE.WINDOW(4).AND.V2.LE.WINDOW(4))  GO  TO  110 

IF  (Vl.GT.WINDOW(4).AND.V2.GT.WINDOW(4) ) GO  TO  150 
IF  (Vl.GT.WINDOW(4) ) GO  TO  100 
U2  = (U2-U1)*(WIND0W(4)-V1)/(V2-V1)+U1 
V2  = WINDOW(4) 

GO  TO  110 

100  U1  = (U1-U2)*(WIND0W(4)-V2)/(V1-V2)+U2 

VI  = WINDOW(4) 

C 

C PLOT  THE  EDGE 
C 

110  LF(LWD.NE,ESPEC(1, J))  THEN 

LWD  » ESPEC(1,J) 

GALL  LINWID(LWD) 

END  IF 

IF(LCL.NE.ESPEC(2,J))  THEN 
LCL  » ESPEC(2,J) 

CALL  COLOR(LCL)  ' 

ENDIF 

CALL  LINE(U1,  VI,  U2,  V2) 

150  CONTINUE 

C 

C PLOT  POLYGONS  ON  TOP  OF  EDGES 
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C 

DO  10  J = 1,  NP 
NUM=0 
C 

C DETERMINE  THE  NUMBER  OF  VERTICES  (NON-ZERO  ENTRIES)  IN  THE 

C POLYGON 

C 

DO  15  1=1,8 

IF(P0LY(I,  J).NE.0)  NUM=NUM+1  ;NUMBER  OF  VERTICES  IN  POLYGON 
15  CONTINUE 

C 

C MOVE  THE  VERTICES  INTO  A LOCAL  WORK  ARRAY 

C 

DO  61  I = 1,  NUM 
DO  61  K = 1,  3 

61  XYZ(K,I)  = VERT£X(K,POLY(I, J)) 

C 

C APPLY  THE  TRANSFORM 

C 

DO  62  I = 1,  NUM 
U1  = XYZ(1,I) 

U2  = XYZ(2,I) 

U3  = XYZ(3,I) 

XYZ(1,I)  = XDC(1,1)*U1  + XDC(1,2)*U2  + XDC(1,3)*U3  + XDC(1,4) 

XYZ(2,I)  = XDC(2,1)*U1  + XDC(2,2)*U2  + XDC(2,3)*U3  + XDC(2,4) 

62  XYZ(3,I)  = XDC(3,1)*U1  + XDC(3,2)*U2  + XDC(3,3)*U3  + XDC(3,4) 

C 

C ADD  PERSPECTIVE 

C 

DO  60  IV=1,NUM 

D = DOZ/((DOZ+XYZ(3,IV))*TANAL) 

X(IV)  = (XYZ(1-,  IV)  - WCX)*D  + WCX 
60  Y(IV)  = (XYZ(2,IV)  - WCY)*D  + WCY 
C 

C PLOT  THE  POLYGON 
C 

IF(PSPEG( 1 , J) .NE. LWD)  THEN 
LWD  = PSPEC(1,J) 

GALL  LINWID(LWD) 

ENDIF 

IF(PSPEC(2,J).NE.LCL)  THEN 
LCL  = PSPEC(2,J) 

GALL  COLOR(LCL) 

ENDIF 

IF(PSPEC(3,J).NE.LFL)  THEN 
LFL  - PSPEC(3,J) 

GALL  FILTYP(LFL) 

ENDIF 

IF(PSPEC(4,J).GE.O)  THEN 
CALL  PLYGON(X,  Y,  NUM) 

ELSE 

GALL  LINES(X(1),  Y( 1 ) , X( 2 ) , Y(2),  NUM-l) 

ENDIF 

10  CONTINUE  ;GET  NEXT  POLYGON 

RETURN 
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SUBROUTINE  VOLFRM  (MODEl) 

C 

C THIS  ENTRY  PUTS  A FRAME  AROUND  THE  REGION  IF  DESIRED. 

C FIRST  PLOT  + AT  ALL  OF  THE  VERTICES. 

C 

COMMON/VOLCOM/XR,YR,A,TP,AP,DK,DY,DZ ,X, Y , Z , SC  1 , FSEG , NTT 
LOGICAL  A(l) 

INTEGER  TP,AP 

DIMENSION  XR(8) ,YR(8) ,DX(4) ,DY(4) ,DZ(4) ,X(4) , Y(4) ,Z(4) ,SC1(4) 
DO  101  I = 1,  8 

101  CALL  CHPLOT  (SCI,  XR(I),  YR(I),  ' + V', 

C 

C NOW  CHECK  THE  VARIOUS  LINES. 

C 

IF  (MODEl  .LE.  1)  GO  TO  102 

CALL  LINE  (XR(1)  ,YR(1)  , XR(2)  ,'fR(2)  ) 

CALL  LINE  (XR(6) ,YR(6) , XR(2),YR(2)) 

CALL  LINE  (XR(6) ,YR(6) , XR(5),YR(5)) 

CALL  LINE  (XR(1),YR(1),  XR(5),YR(5)) 

CALL  VOLUM8  (XR(4) , YR(4) , XR(3),YR(3),  T,  NT) 

CALL  VOLUM8  (XR(4) , YR(4) , XR(8),YR(3),  T,  NT) 

CALL  VOLUM8  (XR(7 ) , YR(7 ) , XR(8),YR(8),  T,  NT) 

CALL  VOLUM8  (XR( 7 ) , YR( 7 ) , XR(3),YR(3),  T,  NT) 

CALL  VOLUM8  (XR(4) , YR(4) , XR(2),YR(2),  T,  NT) 

CALL  VOLUM8  (XR( 1 ) , YR( 1 ) , XR(3),YR(3),  T,  NT) 

CALL  VOLUM8  (XR(6 ) , YR( 6 ) , XR(8),YR(8),  T,  NT) 

CALL  VOLUM8  (XR(7) ,YR(7 ) , XR(5),YR(5),  T,  NT) 

102  CONTINUE 
RETURN 

END 

C 
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3 57  1 

SUBROUTINE  VOLUMO  (Q,  R,  NX,  NY,  NZ 

3572 

C 

3 573 

REAL  X(8),  Y(8),  Q(8),  R(8) 

3 574 

RNX  = 1.0/FLOAT(NX-1) 

3 575 

RNY  = 1. 0/FLOAT(NY-1) 

3 576 

RNZ  = 1.0/FLOAT(NZ-I) 

3 577 

FNX  = NX 

3578 

FNY  = NY 

3 579 

FNZ  = NZ 

3 530 

DO  1 I = 1,  8 

3531 

K(I)  = Q(I) 

3 532 

1 Y(I)  = R(I) 

3 533 

RETURN 

3 584 

C 

3 535 

c 

3 536 

ENTRY  V0LUM6  (:<A,YA,  XG,YG,ZG) 

3537 

c 

3 538 

Dll  = (FNX  - XG)*RNX 

3539 

DJI  = (FNY  - YG)*RNY 

3590 

DKi  = (FNZ  - ZG)*RNZ 

3591 

DIN  = 1.0  - Dll 

3592 

DJN  = 1.0  - DJI 

3 593 

DKN  = 1.0  - DKI 

3594  :<A  = ((X(l)*DIi+K(2)*DIN)*DJl  + (X(3)*DI1+X(4)*DIN)*DJN)*DK1 

3595  1 + ((X(5)*DI1+X(6)*DIN)*DJ1  + (X(7 ) *DI1+X(8 ) *DIN)*D JN) *DKN 

3596  YA  = ((Y( l)*DIi+Y(2)*DIN)*DJl  + (Y(3)*DIi+Y(4)*DIN)*DJN)*DXl 

3597  1 + ( (Y(5)*DIi+Y(6)*DIN)*DJl  + (Y(7 )*DI1+Y(8)*DIN) *DJN)*DKN 

3598  RETURN 

3 599  END 

3600  C 
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3601 

SUBROUTINE  VOLUM7  (GLEVEL,  F00,F10,F1 1 ,F01 

3602 

C 

3603 

REAL  X(4),  Y(4) 

3604 

C 

3605 

c 

AT  LEAST  ONE  GROSSING  WILL  BE  FOUND.  TEST 

3606 

c 

3607 

ISEG  = 0 

3 608 

IF  (FOO.NE.FIO)  DX  = (GLEVEL-F00)/(F10 

3609 

IF  (FOO.EQ.FIO)  DX  = 0.0 

3610 

IF  (DX.GE.1.0  .OR.  DX.LE.0.0)  GO  TO  2 

3'611 

c 

3612 

c 

REGORD  THE  LOWER  GROSSING. 

3613 

c 

3614 

ISEG  = ISEG  + 1 

3615 

X(ISEG)  = DX 

3616 

Y(ISEG)  = 0.0 

3617 

G 

3618 

C 

TEST  THE  RIGHT  SEGMENT. 

3619 

G 

3620 

2 

IF  (FlO.NE.Fll)  DY  = (GLEVEL-F  10) / (F 1 1- 

362  1 

IF  (FlO.EQ.Fll)  DY  = 0.0 

3622 

IF  (DY.GE.1.0  .OR.  DY.LE.0.0)  GO  TO  3 

3623 

G 

3624 

G 

REGORD  THE  RIGHT  SIDE  GROSSING. 

3625 

G 

3626 

ISEG  = ISEG  + 1 

3627 

X(ISEG)  = 1.0 

3628 

Y(ISEG)  = DY 

3629 

G 

3630 

G 

TEST  THE  TOP  SEGMENT. 

3631 

G 

3632 

3 

IF  (Fll.NE.FOl)  DX  = (GLEVEL-FOl ) / (F 1 1- 

3633 

IF  (Fll.EQ.FOl)  DX  = 1.0 

3634 

IF  (DX.GE.1.0  .OR.  DX.LE.0.0)  GO  TO  4 

3635 

G 

3636 

G 

REGORD  THE  TOP  GROSSING. 

3637 

G 

3638 

ISEG  = ISEG  + 1 

3639 

X(ISEG)  = DX 

3640 

Y(ISEG)  = 1.0 

3641 

G 

3642 

G 

TEST  THE  LEFT  SIDE  SEGMENT. 

3643 

G 

3644 

4 

IF  (FOl.NE.FOO)  DY  =•  (GLEVEL-FOO) /(FOl 

3645 

IF  (FOl.EQ.FOO)  DY  =■  1.0 

3646 

IF  (DY.GE.1.0  .OR.  DY.LE.0.0)  GO  TO  5 

3647 

G 

3648 

G 

REGORD  THE  LEFT  SIDE  GROSSING. 

3^9 

G 

3650 

ISEG  - ISEG  -t-  1 

3651 

X(ISEG)  =0.0 

3652 

Y(LSEG)  - DY 

3653 

G 

3654 

G 

SAVE  ANY  LINE  SEGMENTS  FOUND 

3655 

G 
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3656  5 NSEG  = ISEG 

3637  RETURN 

3658  END 
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3659 

3660  C 

3661 

3662 

3663 

3664 

3665 

3666  C 

3667 

3668  G 

3669  C 

3670  C 

3671 

3672 

3673 

3674 

3675 

3676 

3677 

3678 

3679 

3680 

3681 

3682  C 

3683  C 

3684  C 

3685 

3686 

3687  C 

3688  C 

3689  G 

3690 

3691 

3692 

3693 

3694 

3695 

3696 

3697 

3698  G 

3699  G 

3700  C 

3701 

3702 
3 703 

3704 

3705  C 

3706  G 

3707  G 

3708 

3709 

3710 

371 1 

3712 

3713 


SUBROUTINE  VOLUM8  (XA,  YA,  XB , YB , T,  NT) 

GOMMON/ VOLCOM/XR , YR , A , TP, AP , DX , DY , DZ , P , Q , R , SG 1 , FSEG , NTT 
DIMENSION  XR(8) ,YR(8) ,DX(4) ,DY(4) ,DZ(4) ,P(4) ,Q(4) ,R(4) ,SG1(4) 
LOGIGAL  T(NT,  NT) 

DATA  KING  / 1 / 

LOGIGAL  SWl 

IF  (SQRT((XB-XA)**2  + (YB-YA)**2)  .LT.  1.9)  RETURN 

GHEGK  FOR  HIDDEN  PORTIONS  OF  THE  LINE. 

RSEG=FLOAT(NTT) / 1 024. 

lAT  = RSEG*XA 

IBT  = RSEG*XB 

JAT  = RSEG*YA 

JBT  = RSEG*YB 

KI  = ABS(XB-XA) 

KJ  = ABS(YB-YA) 

IF  (KI.GT.120  .OR.  KJ.GT.120)  GO  TO  1 

IF  ( .NOT.T(IAT, JAT)  .OR.  . NOT . T( IBT , JBT) ) GO  TO  1 

GALL  LINE  (XA,YA,  XB,YB) 

RETURN 

AT  LEAST  PART  OF  THE  LINE  IS  HIDDEN.  FIND  REASONABLE  LIMITS. 

1 KMAX  = (MAXO(XI,KJ)/XINC)*KING  + i 
IF  (KMAX  .LT.  2)  RETURN 

NOW  GHEGK  EAGH  SEGMENT  ALONG  THE  LINE. 


SWi  = .FALSE. 

DO  2 K = 1,  KMAX,  KING 

FA  = FLOAT(K-l) /FLOAT (KMAX- 1) 

X = XA  + FA*(XB  - XA) 

Y = YA  + FA*(YB  - YA) 

IX  = RSEG*X 
lY  = RSEG*Y 
IF  (SWi)  GO  TO  3 

UPDATE  THE  FIRST  POINT  IF  SWI  IS  .FALSE. 

IF  (.NOT.T(IX, lY))  GO  TO  3 

XST  « X 

YST  - Y 

SWI  = .TRUE. 

SET  THE  END  POINT. 

3 IF  (T(IX,IY)  .AND.  K.NE.KMAX)  GO  TO  2 
IF  ( .NOT. SWI)  GO  TO  2 
FB  - FLOAT(K-l -KING )/FLOAT( KMAX- 1) 

XND  - XA  + FB*(XB  - XA) 

YND  - YA  + FB*(YB  - YA) 

CALL  LINE  (XST.YST,  XND, YND) 


■>  ’S- 
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3714  SWl  =■  .FALSE. 

3 71  5 2 CONTINUE- 

3716  RETURN 

3717  END 

3718  C 
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C 

C 

C 

C 

c 

c 

G 

C 

c 

c 

c 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

G 

C 

G 


SUBROUTLNE  VOLUME  (MODE,  F,  NX,NY,NZ,  GLEVE , NCL,  T,  NT) 


THIS  SET  OF  ROUTINES  IS  DESIGNED  TO  DRAW  ON  A DEVIGE,  SUGH  AS 
A PRINTER,  A PLOTTER,  THE  SC4020  OR  THE  TEK.TRONIGS  GRAPHIGS 
TERMINAL,  A TWO-DIMENSION  PROJEGTION  OF  A THREE  DIMENSIONAL 
ARRAY  (FIGURE).  THE  HIDDEN  LINES  ARE  ELIMINATED  TO  SIMULATE 
THE  EFFEGT  OF  ”3D". 

THE  GO LOR  OF  THE  FIGURES  (FOR  THE  SG4020  ONLY)  MUST  BE  SET 
BY  THE  USER  IN  THE  GALLING  PROGRAM  USING  THE  APPROPRIATE  GALLS 
TO  THE  GRAPHIGS  PAGKAGE. 

THE  AXIS  ARE  LABELED  AS  FOLLOWS:  X IS  LEFT  TO  RIGHT 

Y IS  INTO  THE  PAGE 
Z IS  BOTTOM  TO  TOP 

TO  INITIALIZE  THE  PLOTTING  PAGKAGE,  "VOLSET"  MUST  BE  GALLED. 

IF  A FRAME  SURROUNDING  THE  DRAWING  IS  WANTED,  GALL  "VOLERM’’. 

THE  ROUTINE  LOOPS  OVER  THE  Y AXIS  FROM  FRONT  TO  BAGK,  PLOTTING 
EAGH  SUGGESSIVE  (X,Z)  PLANE.  AT  THE  END  OF  THE  (X,Z)  GYGLE, 

THE  ARRAY  ”T"  IS  SET  TO  INDIGATE  WHAT  WILL  BE  HIDDEN  BY  THE 
GURRENT  PLANE. 

GALLING  SEQUENGE  OR  OPERATIONAL  PROCEDURE: 

CALL  VOLSET(XP,  YP,  T,  NT) 

CALL  VOLUME  (MODE,  F,  NX,  NY,  NZ , GLEVE,  NCL) 

GALL  VOLFRM(MODEl) 

ARGUMENTS  (TYPE  AND  SIGNIFICANCE)  AND/OR  INITIAL  CONDITIONS; 

XP  CONTAINS  THE  LOCATIONS  OF  THE  X POSITION  OF  THE  VERTICES  (8) 
YP  CONTAINS  THE  CORRESPONDING  Y VALUES  (8) 

T IS  THE  PLOTTING  ARRAY  (BOOLEAN)  TO  ELLMINATE  THE  HIDDEN  LINES 
WHICH  IS  NT  X NT  IN  SIZE  (THIS  ARRAY  TOGETHER  WITH 
NX,NY,NZ  DETERMINE  THE  FINESSE  OF  THE  PLOT). 

MODE  DETERMINES  WHICH  SURFACE  IS  PLOTTED  (USED  WITH  GLEVE) 
ABS(MODE)=l  WILL  PLOT  THE  CONTOUR  LEVEL  "CLEVE"  IN  EACH  PLANE 
AND  THEN  FIXES  THE  HIDDEN  LINE  MATRIX  "T". 
ABS(MODE)-2  SLMPLY  FIXES  THE  HIDDEN  LINE  MATRIX  ”T"  WITHOUT 
PLOTTING.  THIS  IS  USEFUL  IN  AVOIDING  MULTIPLE 
PLOTS  OF  THE  SAME  FIXED  FIGURE. 

M0DE<0  IS  USED  WHEN  THE  VALUE  OF  THE  FUNCTION  ON  THE 

"OUTSIDE"  IS  LESS  THAN  "GLEVE". 

MODE>0  IS  USED  WHEN  THE  VALUE  OF  THE  FUNCTION  ON  THE 

"OUTSIDE"  IS  GREATER  THAN  "GLEVE". 

F IS  THE  THREE-DIMENSIONAL  FIGURE  TO  BE  PLOTTED. 

NX,NY,NZ  ARE  THE  DIMENSIONS  OF  THIS  .ARRAY  <F(NX,  NY,  NZ)> 

GLEVE  IS  THE  CONTOUR  SURFACE  LEVEL  FOR  PLOTTING. 

NCL  IS  THE  NUMBER  OF  PAIRS  OF  (MODE, GLEVE)  TO  BE  PLOTTED. 

MODE  I IS  THE  MODE  OF  FRAMING  0->  AT  THE  EIGHT  VERTICES; 

l->  A BOX  FORMED  BY  LINES. 
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377^  C 
3 775 
3 776 
3 77  7 
3778 
3 779 

3780 

3781  C 
3 782 
3733  C 

3784  C 

3785  C 
3 736 

3 737 
3738  C 

3789  C 

3790  C 

3791 

3792 

3793 
3 794 
3795  C 
3 796  C 

3797  C 

3798 

3799 

3800 

3801 
3302 

3803 

3804 

3805 
380o 
3 SO  7 
3308 

3809 

3810 

381 1 

3812 

3813 

3814 

3815 

3816 

3817 

3818 

3819 

3820 

3821 

3822 

3823 

3824 

3825 

3826 

3827 

3828 


COMMON/VOLCOM/XR,YR,A,TP,AP,DX,DY,DZ ,X, Y,Z ,SCi , FSEG,NTT 
LOGICAL  T(NT,NT) 

DIMENSION  XR(8) , YR(8 ) , DX(4 ) , DY(4) ,DZ(4) ,X(4) , Y(4) ,Z(4) ,SCi(4) 
INTEGER  MODE(NCL) 

REAL  F(NX,NY,NZ),  CLEVE(NCL) 

REAL  XP(8),  YP(8) 

CALL  VOLUTiO  (XR,YR,  NX,NY,NZ) 

THE  OUTER  LOOP  IS  OVER  THE  I,K  SURFACES  MOVING  BACK. 

DO  1 J = 1,  NY 
IF  (J.EQ. 1)  GO  TO  2 

THEN  LOOP  OVER  THE  VARIOUS  CONTOUR  LEVELS. 

DO  20  LL  = 1,  NCL 
CLEVEL  = CLEVE(LL) 

MODEL  = MODE(LL) 

IF  (lABS  (MODEL)  .EQ.  2)  GO  TO  20 

FIRST  COMPUTE  THE  FRONT -TO-BACK  LINE  SEGMENTS. 

DO  3 I = 1,  NX 
DO  4 K = 2,  NZ 

FMAX  = AMAXl  ( F( I , J-1 , K-1 ) , F(I,J,K-1),  F(I,J,K),  F(I,J-1,K)) 
FMIN  = AMINl  (F(I, J-1 ,K-1) , F(I,J,K-1),  F(I,J,K),  F(I,J-1,K)) 
IF  ( FMAX.  LT.  CLEVEL  .OR.  FMIN. GT . CLEVEL)  GO  TO  4 
GALL  VOLUM7  (CLEVEL,  F( I , J-1 , K-i ) , F(I,J,K-1), 

1 F(I,J,K),  F(I,J-1,K),  NSEG,  DY,  DZ) 

IF  (NSEG  .LE.  1)  GO  TO  4 
DO  5 L = 1,  NSEG 
X(L)  = FLOAT(I) 

Y(L)  = FLOAT(J-l)  + DY(L) 

5 Z(L)  = FLOAT(K-l)  + DZ(L) 

CALL  VOLUM6  (XA.YA,  X( 1 ) , Y( 1 ) ,Z( 1 ) ) 

CALL  VOLUM6  (XB,YB,  X(  2 ) , Y(  2 ) , Z(  2 ) ) 

GALL  VOLUM8  (XA,YA,  XB,YB,  T,  NT) 

IF  (NSEG.NE.4)  GO  TO  4 

CALL  VOLUM6  (XA,YA,  X(3) , Y(3) ,Z(3) ) 

CALL  VOLUM6  (XB,YB,  X(4) ,Y(4) ,Z(4) ) 

CALL  VOLUM8  (XA,YA,  XB,YB,  T,  NT) 

4 CONTINUE 

3 CONTINUE 

DO  6 K - 1,  NZ 
DO  7 I - 2,  NX 

FMAX  = AMAXl  ( F( I-l , J-1 , K) , F(I,J-1,K),  F(I,J,K),  F(I-l,J,K)) 
FMIN  =.  AMINl  (F(I-1,J-1,K),  F(I,J-1,K),  F(I,J,K),  F(I-1,J,K)) 
IF  ( FMAX.  LT.  CLEVEL  .OR.  FMIN.  GT . CLEVEL)  GO  TO  7 
CALL  VOLUM7  (CLEVEL,  F(  I-l , J-1 , K)  , F(I,J-1,K), 

1 F(I,J,K),  F(I-1,J,K),  NSEG,  DX,  DY) 

IF  (NSEG  .LE.  1)  GO  TO  7 

DO  8 L - 1,  NSEG 

X(L)  - FLOAT(I-l)  + DX(L) 
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3829 

3830 

3831 

3832 
3-333 

3834 

3835 

3836 

3837 

3838 

3839 

3840 

3841  C 

3842  G 

3843  C 

3844  G 

3845 

3846 

3847 

3848 

3849 

3850 

3851 

3852 

3853 

3854 

3855 

3856 

3857 

3858 

3859 

3860 

3861 

3862 

3863 

3864 

3865 

3866 

3867 

3868 

3869 

3870 

3871  G 

3872  G 

3873  G 

3874 

3875 

3876 

3877 

3878 

3879 

3880 

3881 

3882 

3883  C 


Y(L)  = FLOAT(J-l)  + DY(L) 

8 Z(L)  = FLOAT(K) 

GALL  VOLUM6  (XA,YA,  X( 1 ) , Y( 1 ) ,Z( 1 ) ) 

GALL  VOLUM6  (XB,YB,  X(2) , Y(2) ,Z(2) ) 

GALL  VOLUM8  (XA,YA,  XB,YB,  T,  NT) 

IF  (NSEG, NE.4)  GO  TO  7 

GALL  VOLUM6  (XA,YA,  X( 3 ) , Y( 3 ) , Z( 3 ) ) 

GALL  VOLUM6  (X3,Y3,  X(  4 ) , Y(  4 ) , Z(  4 ) ) 

GALL  VOLUM8  (:CA,YA,  X3,Y3,  T,  NT) 

7 GO NT IN UE 

6 GONTINUE 

20  GONTINUE 

NOW  PLOT  THE  X-Z  SURFAGE  GONTOURS  BEFORE  GORREGTING  THE  HIDDEN 

LINE  ARRAY. 

2 DO  21  LL  = 1,  NGL 

GLEVEL  = GLEVE(LL) 

MODEL  = MODE(LL) 

IF  (LABS  (MODEL)  . EQ.  2)  GO  TO  21 
DO  9 K.  = 2,  NZ 
DO  10  I = 2,  NX 

FMAX  = AMAXl  (F(  I-l , J , K-1 ) , F(I,J,K-1),  F(I,J,K),  F(I-1,J,K:)) 
FMIN  = AMINl  (F(I-1,  J,K-1) , F(I,J,R-1),  F(I,J,K.),  F(I-l,J,iC)) 
IF  (FMAX.  LT. GLEVEL  .OR.  FMIN.  GT . GLEVEL)  GO  TO  10 
GALL  VOLUM7  (GLEVEL,  F(I-1 , J,K-1 ) , F(I,J,K.-1), 

1 F(I,J,X),  F(I-1,J,K),  NSEG,  DX,  DZ) 

IF  (NSEG  .LE.  1)  GO  TO  10 

DO  11  L = 1,  NSEG 

X(L)  = FLOAT(I-l)  + DX(L) 

Y(L)  = FLOAT(J)  ■ 

11  Z(L)  = FLOAT(K-l)  -i-  DZ(L) 

GALL  VOLUM6  (XA,YA,  X( 1 ) ,Y( 1 ) ,Z( 1 ) ) 

GALL  VOLUM6  (XB,YB,  X(  2 ) , Y(  2 ) , Z(  2 ) ) 

GALL  VOLUM8  (XA,YA,  XB,YB,  T,  NT) 

IF  (NSEG,  NE.4)  GO  TO  10 

GALL  VOLUM6  (XA.YA,  X(3 ) , Y( 3 ) , Z( 3 ) ) 

GALL  VOLUM6  (XB,YB,  X(  4 ) , Y(4  ) , Z(  4 ) ) 

GALL  VOLUM8  (XA,YA,  XB,YB,  T,  NT) 

10  GONTINUE 

9 GONTINUE 

21  GONTINUE 

FILL  THE  HIDDEN  LINE  ARRAY  AFTER  PLOTTING  IN  THE  NEW  PLANE. 

DO  22  LL  - 1,  NGL 
GLEVEL  =-  CLEVE(LL) 

MODEL  - MODE(LL) 

DO  12  K - 2,  NZ 
DO  13  I - 2,  NX 

IF  (MODEL. GT.O  .AND.  AMIN  1 ( F(  I-l , J , K- I ) , F(l,J,K-l), 

I F(I-l,J,X),  F(l,J,X)).GT. GLEVEL)  GO  TO  13 

IF  (MODEL. LT.O  .AND.  AMAX I ( F(  I- 1 , J , X- 1 ) , F(I,J,K-l), 

I F(1-1,J,X),  F(l,J,K)).LT. GLEVEL)  GO  TO  1 3 


1 -•)  0 
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THERE  IS  HIDDEN  STUFF  SOMEWHERE  IN  THE  CELL,  FIRST  FIND  THE  LIMITS 
OF  THE  CELL. 

CALL  VOLUM6  (XOO,YOO,  FLOAT(I-l),  FLOAT(J),  FLOAT(K-l)) 

CALL  VOLUM6  (X10,Y10,  FLOAT(I  ),  FLOAT(J),  FLOAT(K-l)) 

CALL  VOLUM6  (XLl.Yll,  FLOAT(I  ),  FLOAT(J),  FLOAT(K  )) 

CALL  VOLUM6  (XOl.YOl,  FLOAT(I-l),  FLOAT(J),  FLOAT(K  )) 

DXMAX  = AMAXl  ( ABS( XIO-XOO) , ABS(X 1 1-XO L ) ) 

DYMAX  = .\MAXI  ( A3S  ( YO 1 -YOO ) , ABS ( Y 1 L-Y  iO)  ) 

NSEGX  = (DXMA:^  + FSEG)/FSEG 

NSEGZ  = (DYMAX  + FSEG)/FSEG 

DII  = i.O/NSEGX 

DRX  = i.O/NSEGZ 

DO  14  II  = i,  NSEGX 

XGRID  = (FLOAT(II)  - 0.5)*DII 

DO  15  KX  = 1,  NSEGZ 

ZGRID  = (FLOAT(KK)  - 0.5)*DKK 

CALL  VOLUM6  (XA , YA , XGRID+FLOAT( I-l ) , FLOAT( J ) , ZGRID+FLOAT( X-1 ) ) 
IXA  = XA/FSEG 
UA  = YA/FSEG 

IF  (.NOT.T(IXA,IYA))  GO  TO  15 
FIND  THE  VALUE  OF  F AT  THE  POINT  UNDER  SCRUTINY. 

FVAL  = (F(I-l,J,K-i)*(i.O-XGRID)+F(I, J,X-l)*XGRID)*(i.O-ZGRID) 
1 + (F(I-l,J,K)*(i.O-XGRID)  +F(I,J,K)*XGRID)*ZGRID 

IF  (MODEL.GT.O,  AND.  FVAL.  LT.CLEVEL)  T(IXA,IYA)  = .FALSE. 

IF  (MODEL.  LT.O.  AND.  FVAL.  GT.CLEVEL)  T(IXA.IYA)  = .FALSE. 

15  CONTINUE 

14  CONTINUE 

13  CONTINUE 

12  CONTINUE 

22  CONTINUE 

I CONTINUE 

RETURN 

ENTRY  VOLSET  (XP,  YP,  T,  NT) 

THIS  FIRST  ENTRY  INITIALIZES  THE  PLOT  GEOMETRY  AND  FILLS  THE 
HIDDEN  LINE  ARRAY  T WITH  THE  INITIAL  .TRUE.  FOR  TRANSPARENT.  THE 
ARRAY  T IS  NT  X NT  (OR  16K.  WORDS  MAX)  AND  IS  PASSED  IN  FROM  THE 
OUTSIDE.  THIS  CORRESPONDS  TO  1024/NT  RASTER  UNITS  ON  THE  SC4020. 


SCl(l)  » 1.0 
SC1(2)  - 0.0 
SC1(3)  =•  i.O 
SCi(4)  - 0.0 
DO  100  I =-  1,  NT 
DO  100  J - 1,  NT 
100  T(I,J)  » .TRUE. 

FSEG  - 1024.0/FLOAT(NT) 
DO  103  I - 1,  8 
XR(I)  - XP(I) 
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103  YR(I)  = YP(I) 
NTT  = NT 
RETURN 

END 


j < . ■ 


. ‘ 


(■ 


•i  i ; 


3943 

3944 

3945 

3946 

3947 

3948 

3949 

3950 

3951 

3952 

3953 

3954 

3955 

3956 

3957 

3958 

39  59 

3960 

3961 

3962 

3963 

3964 

3965 

3966 

3967 

3968 

3969 

3970 

3971 

3972 

3973 

3974 

3975 

3976 

3977 

3978 

3979 

3980 

3981 

3982 

3983 

3984 

3985 

3986 

3987 

3988 

3989 

3990 

3991 

3992 

3993 

3994 

3995 

3996 

3997 


SUBROUTINE  WDCOUNT 


page  94 


SUBROUTINE  WDCOUNT(W,NC) 

C 

C COUNT  THE  NUMBER  OF  CHARACTERS  (LEGITIMATE)  IN  A STRING 
C 

CHARACTER*!  W(*),  E,  P,  B,  H,  U,  D,  L,  C,  R,  0,  M 
DATA  E/  ' V / ,P/  ’ . 7 ,B/  'B7  ,H/'H7  ,U/  'U  7 ,D/  ’D7  ,L/'L7 
DATA  C/'C7,R/’R7,0/’07,M/'M7 
C 

IP  = 0 ; NO  CHARACTERS 
I = 1 

100  IF(W(I).EQ.E)  THEN 

IF(W(I+1).EQ.H)  THEN 
1 = 1+2 
ELSE 

IF(W(I+1),EQ.U)  THEN 
ELSE 

IF(W(I+1).EQ.D)  THEN 
ELSE 

IF(W(I+1).EQ,L.0R.W(I+1).EQ.R.0R.W(I+1).EQ.M)  THEN 
ELSE 

IF(W(I+1).EQ, B)  THEN 
ELSE 

IF(W(I+l).EQ.O)  THEN 
ELSE 

IF(W(I+1).EQ.C)  THEN 
1 = 1 + 2 
ELSE 

IF(W(I+1).EQ.E)  THEN 
GO  TO  200 
ELSE 

IF(W(I+1).EQ.P)  THEN 
GO  TO  300 
ELSE 

GO  TO  101 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ELSE 

GO  TO  200 
ENDIF 
C 

101  1=1+2 

IF(I.GT.132)  GO  TO  400  ; QUIT  ANYHOW 
GO  TO  100 
C 

C COUNT  A CHARACTER 
C 


200 


I - I + 1 
IP  - IP  + 1 
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3998 

O 

H 

s 

3999 

C 

4000 

c 

TERMINATE 

4001 

c 

4002 

300 

NC  = IP 

4003 

RETURN 

4004 

c 

4005 

c 

TERMINATE 

4006 

c 

4007 

400 

NC  = 0 

4008 

RETURN 

4009 

END 

_ > 1 » 
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SUBROUTINE  WD DRAW (XS TART,  YSTART,  DX,  DY,  SX,  SXY,  SY,  W) 
C 


c 

c 

c 

c 

c 


c 

c 

c 

c 

G 

C 

c 

c 

c 


XSTART 

REAL 

YSTART 

REAL 

DX 

REAL 

DY 

REAL 

SX 

REAL 

SXY 

REAL 

SY 

REAL 

w 


- X COORDINATE  (MATHEMATICAL  SPACE)  OF  THE  FIRST 
CHARACTER  TO  BE  DRAWN 

- Y COORDINATE  (MATHEMATICAL  SPACE)  OF  THE  FIRST 
CHARACTER  TO  BE  DRAWN 

- INCREMENT  TO  BE  ADDED  TO  THE  X COORDINATE  FOR 
EACH  CHARACTER  DRAWN 

- LNCREl-lENT  TO  BE  ADDED  TO  THE  Y COORDINATE  FOR 
EACH  CHARACTER  DRAWN 

- X MATH  SPACE  SIZE  FOR  CHARACTERS 

- SLANT  MODIFIER  FOR  CHARACTERS 

- Y MATH  SPACE  SIZE  FOR  CHARACERS 

- CHARACTER  STRING  TO  BE  DRAWN. 


CONTROL  CHARACTERStL  - TEXT  IS  DRAWN  TO  THE  LEFT  OF  XS  TART , YSTART 

1M  - TEXT  IS  CENTERED  AT  XS  TART , YSTART 

1R  - TEXT  IS  DRAWN  TO  THE  RIOIT  OF  XS  TART , YSTART 


C 


C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

G 


1U 

ID 

10 


IB 


C 


c 

G 

C 

C 

c 

c 

c 


1C 


1. 


CHANGE  CHARACTER  SETS  ...  IHOi,  1H02, 

...  1H20,  1H21  FOR  CHARACTER  SETS 
1,  2,  ...  20,  AND  21. 

DRAW  THE  FOLLOWING  CHARACTERS  LN 
SUPERSCRIPT. 

DRAW  THE  FOLLOWING  CHARACTERS  IN  SUBSCRIPT. 
RESET  CHARACTER  SIZE  AND  PLACEMENT  FROM 
SUPERSCRIPT  OR  SUBSCRIPT  TO  ORIGINAL 
SIZE. 

BACKSPACE  OVER  LAST  CHARACTER  DRAWN. 

WORKS  ONLY  FOR  ONE  CHARACTER.  MULTIPLE 
BACKSPACES  WILL  PRODUCE  UNPREDICTABLE 
RESULTS. 

CHANGE  COLOR,  1C00,  1C01,  ...  TO  CHANGE 
TO  COLOR  0,  1,  ... 

END  OF  CHARACTER  STRING. 


C* ****************************** A* ************************* ************* 


C WDDRAW 


C* ***************************************************************  ******* 

C 


INTEGER  CHNUMB,  SDFLT 

CHARACTER*!  W( I ) , E,  P,  B,  CC(4),  H,  U,  D,  L,  C 
CHARACTER*!  CENTER,  R,  0,  M 

DATA  E/  ‘1  V,P/’.  V,B/’B'/,H/'H'/,U/'U'/,D/’DV,L/'L'/ 

DATA  C/'G'/,R/’R'/,0/'OV,M/'M’/,  SDFLT/4/,  SE/4/ 

REAL  X(132),Y(132),SCL(132),XLL(125),YLL(125),PEN( 125) 
COMMON  /DEVTYP/  IDEVIC , LSW ,LTSW ,XYCOOD(4) , LUOUT , LPAGE 
COMMON/GRFTYP/ ANGLE, IRVRSE, CHSIZE(9) ,ITKWIT,LUDIAG,LUHSET 
EQUIVALENCE  (CC,  CHNUMB) 

INTEGER  SETL(132),  SE,  CH(132),  ICL(132) 

C 

C 
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C SET  THE  PLOTTING  SPACE  PARAMETERS 
C 

CHSIZE(2)  = SY  * XYCOOD(3)  * CHSIZE(6) 

CHSIZE(7)  = CHSIZE(2)*(CHSIZE(3)+.5*(1.8-CHSIZE(6)))/XYCOOD(l) 
CHSIZE(8)  = CHSIZE(2)*(CHSIZE(4)+.  5*(1.8-CHSIZE(6)  ))/XYCOOD(3) 
C 

XL  = 0.0 
YL  = 0,0 
IP  = 0 
ICOL  = 0 
XLAST  = XL 
WIDTH  =0.0 
SC  = 1.0 
IC  = 1 
1=1 

CENTER  = 'R' 

C 

C SCAN  THE  LNPUT  STRING  FOR  JUSTIFICATION  AND  END  OF  TEXT 
C 

100  IF(W(I).EQ.£)  THEN 

IF(W(I+1).EQ.H)  THEN 

SE  = CTOI(W(I+2) ,IC)*10  + CTOI(W(I+3) ,IC) 

IF  (SE.LT.  1.0R.SE.GT.24)  SE  = SDFLT 
1 = 1 + 2 
ELSE 

IF(W(I+1).EQ.U)  THEN 

XL  = XL  + SX  * 0.20  * SC 

YL  = YL  + SY  * 0.8  * SC 

SC  = SC  * 0.6 

ELSE 

IF(W(I  + 1).EQ.D)  THEN 

XL  = XL  + SX  * 0,06  * SC 

YL  = YL  - SY  * 0.20  * SC 

SC  = SC  * 0.6 
ELSE 

IF(W(I+l).EQ.L.OR.W(I+l).EQ.R.OR.W(I+l).EQ.M)  THEN 
CENTER  = W(I+1) 

ELSE 

IF(W(I+1).EQ.  B)  THEN 
XL  = XL  - WLAST 
ELSE 

IF(W(I+l).EQ.O)  THEN 
YL  - 0.0 
SC  = 1.0 
ELSE 

IF(W(I+1).EQ.C)  THEN 

ICOL  = CTOI(W(I+2), IC)*10  + CTOI(W( 1+3) , IC) 

1 = 1 + 2 
ELSE 

IF(W(I+1).EQ.E)  THEN 
GO  TO  200 
ELSE 

IF(W(I+1). EQ. P)  THEN 
GO  TO  300 
ELSE 
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1=1-1 
GO  TO  101 
ENDIF 
END  IF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ENDIF 
ELSE 

GO  TO  200 
ENDIF 
C 

101  1=1+2 

IF(I.GT.132)  GO  TO  300  , QUIT  ANYHOW 
GO  TO  100 
C 

C WE  HAVE  A CHARACTER 
C 

200  IF(SE.EQ,  1)  THEN 

CC(1)  = W(I) 

CWMIN  = 0. 

CWMAX  = SX 
ELSE 

CHNUMB  = IDCHAR(W(I)) 

CALL  HSETS  (CHNUMB , XLL , YLL , PEN , NR, SE-1 , lER) 
IF(IER.NE.O)  THEN 

IF(LUDLAG.GT.O)  WRITE ( LUDLAG , 20 1 ) CHNUMB , SE  ,W(  I ) 

201  FORMATC  CHARACTER  ',Z10,'  NOT  FOUND  IN  SET  ',I4,Z5) 
GO  TO  203 

ENDIF 

IF(NR.EQ.  0)  THEN 
CWMIN  =0.0 
CWMAX  = SX  * 0.6 
ELSE 

CWMIN  = l.OE+10 
CWMAX  = 0. 

DO  202  J = 1,  NR 

XLL(J)  = XLL(J)  * 0.216  * SX 

CWMIN  = MIN  (CWMIN,  XLL(J)) 

202  CWMAX  = MAX  (CWMAX,  XLL(J)) 

ENDIF 

ENDIF 

C 

C STORE  ITS  PARAMETERS  IN  LOCAL  SPACE 
C 

XLAST  = XL 
IP  - IP  + 1 
X(IP)  = XL  - CWMIN 
Y(IP)  - YL 
ICL(IP)  - ICOL 
SCL(IP)  - SC 
CH(IP)  - CHNUMB 
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SETL(IP)  = SE 

WLAST  = (0.500*SC+0.5)*(CWMAX-CWMIN)  + 0. 20*SC*DX 
XL  = XL  + WLAST 
YL  = YL  + DY 
203  1 = 1 + 1 

GO  TO  100 
C 

C DRAW  IT  - FIRST  SET  THE  CORRECT  CENTERING 
C 

300  XOFF  = X(l) 

WIDTH  = XL  - XOFF 

IF  (CENTER.  EQ,R)  THEN 
DXX  = 0.0 

ELSE  IF  (CENTER.  SQ.M)  THEN 
DXX  = WIDTH  / 2. 

ELSE  IF  (CENTER. EQ.L)  THEN 
DXX  = WIDTH 
END  IF 

DO  301  I = 1,  IP 

301  X(I)  = X(I)  - XOFF  - DXX 
C 

C DO  ANY  SHIFTING  AND  NECESSARY  ROTATIONS 
C 

COSX  = COS (ANGLE) 

SINX  = SIN (ANGLE) 

SXX  = ABS(XYCOOD(l)) 

SYY  = ABS(XYCOOD(3)) 

OSX  = 1.  / SXX 
OSY  = 1.  / SYY 
DO  304  I = 1,  IP 

XI  = X(I)  * COSX  * SXX  - Y(I)  * SINX  * SYY 
YI  = X(I)  * SINX  * SXX  + Y(I)  * COSX  * SYY 
X(I)  = XI  * OSX  + XSTART 

304  Y(I)  = YI  * OSY  + YSTART 
C 

C NOW  DO  THE  DRAW 
C 

IF(IP.LE.O)  GO  TO  303  , NOTHING  TO  DO 
ICOL  = 0 

DO  305  J = 1,  IP 

IF(ICL(J).NE.O.AND.  ICL(J).NE.  ICOL)  THEN 
CALL  COLOR(ICL(J) ) 

ICOL  = ICL(J) 

ENDIF 

305  CALL  HHDRAW  (X(J),  Y(J),  SX*SCL(J),  SXY,  SY*SCL(J), 

CH(J),  SETL(J),  lER) 

303  CHStZE(2)  - CHSIZE(l) 

ANGLE  = 0.0 
RETURN 
C 

C CHANGE  THE  DEFAULT  CHARACTER  SET  - BYPASS  THE  ESCAPE  SEQUENCE 

C 

ENTRY  CHRSET  (ISET) 

IF( ISET.GT.O)  SE  - ISET 
LF(LUDIAG.GT.O)  WRITE(LUDIAG, 302 ) ISET 
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4230 

4231 

4232 

4233 


RETURN 

302  FORMAT ( ' CHANGE  THE  DEFAULT  CHARACTER  SET  TO  #',I3) 

RETURN 
END 


_ O Q 


NBS-H4A  iREv.  2-80 

U.S.  DEPT.  OF  COMM. 


BIBLIOGRAPHIC  DATA 
SHEET  (See  instructions) 
4.  TITLE  AND  SUBTITLE 


PUBLICATION  OR 
REPORT  NO. 


2.  Performing  Organ.  Report  No.  3. 


NBSIR  85-3235 


PubI  i cation  D ate 

October  1985 


A Device  Independent  Graphics  Kernel 


5.  AUTHOR(S) 

Walter  W.  Jones  and  Alicia  B.  Fadell 


6.  PERFORMING  ORGANIZATION  (If  joint  or  other  than  NBS,  see  in  struction  sj  7.  ContracL''Grant  No. 

NATIONAL  BUREAU  OF  STANDARDS  

DEPARTMENT  OF  COMMERCE  8.  Type  of  Report  & Period  Covered 

Gaithersburg,  Maryland  20899 


9.  SPONSORING  ORGANIZATION  NAME  AND  COMPLETE  ADDRESS  (Street.  City,  State.  ZIP) 


10.  SUPPLEMENTARY  NOTES 


I ! Document  describes  a computer  program;  SF-185,  FlPS  Software  Summary,  is  attached. 

11.  ABSTRACT  (A  200-word  or  less  factual  summary  of  most  significant  information.  I f document  includes  a significant 
bi bliography  or  literature  survey,  mention  it  here) 

This  paper  describes  an  interface  for  programs  which  allows  one  to  write  graphics 
primitives  to  several  devices  without  regard  for  the  type  of  device.  The  most 
salient  features  are  that  it  has  low  overhead,  is  transportable  and  can  be  expanded 
as  the  nature  of  the  input/output  devices  changes.  A conscious  effort  has  been 
made  to  include  all  normal  graphics  primitives  together  with  the  most  useful  high 
level  routines  without  compromising  the  use  of  special  features  of  custom  display 
units. 


12.  KEY  WORDS  (S/x  to  twelve  entries;  alphabetical  order;  capitalize  only  proper  names;  and  separate  key  words  by  semicolon  s) 

device  independence;  display  devices;  graphics 

13.  AVAILABILITY 
[_j^  Unlimited 

For  Official  Distribution.  Do  Not  Release  to  NTIS 

1 1 Order  From  Superintendent  of  Documents,  U.S.  Government  Printing  Office,  Washington,  O.C 

20402. 

fXl  Order  From  National  Technical  Information  Service  (NTIS).  Springfield,  VA.  22161 

14.  NO.  OF 

PRINTED  PAGES 

241 

15.  Price 

USCOmm-OC  «04,i.p«0 


i'ii7T!rnjr  ♦V-’  Ttn  •ST, 


flO'  wd^Aj'j 


■Vp^4-'i'W.U' 


if!§| 

rsiTis 


f t 


.,_  ml#  - 


0p*«'»*7  ’"^  I*  • ■'•^^  'b  ai*j>'T  ai 


■fS:' 


■•vttL  .Jir;7 


aWi 


.%V 


lOI 


A — fi-- 


4 £ e,T^4r’ri'T  ,,© 

} — '■  Jfc  ;.1..Lj  /a.  1,-r.'  j; '.•*  ‘^\-li,'.v.'.i’ ^'fci  • l_'Cl.-..^^tC. 


U ‘^itm 


,B$lrtv 


. J '.Is  I 


'M 


' -4 


ic 


il.' 


' ye  >^*k0 

.\t*  " '■■“"  ■■'"*“ 


''W''ij'iiAj.<'' *A  iH[’ 


0"  ' 


^Tr>^  O 'ih  •? 


